1. 修改了部分提示功能,以及qDebug的日志输出

LAMPCAE-dev-merge
剑古敛锋 2025-03-13 16:33:17 +08:00
parent 6d6d00d690
commit 31666a31ff
357 changed files with 1110 additions and 248739 deletions

View File

@ -83,6 +83,23 @@ if (NOT DEFINED Qt5_DIR)
endif()
endif()
#-----------------------------------------------------------------------------
# vcpkg
#-----------------------------------------------------------------------------
set(CMAKE_TOOLCHAIN_FILE "D:/vcpkg/scripts/buildsystems/vcpkg.cmake")
set(VCPKG_ROOT "D:/vcpkg/installed/x64-windows")
set(VCPKG_INCLUDE_DIR ${VCPKG_ROOT}/include)
set(VCPKG_LIB_DIR ${VCPKG_ROOT}/lib)
message("${VCPKG_ROOT}")
#-----------------------------------------------------------------------------
#
#-----------------------------------------------------------------------------
@ -258,6 +275,20 @@ find_package(unofficial-sqlite3 CONFIG REQUIRED)
# openmesh
find_package(OpenMesh CONFIG REQUIRED)
#opengl
find_package(OpenGL REQUIRED)
message("VCPKG_INSTALLED_DIR ${VCPKG_INSTALLED_DIR}")
message("CMAKE_SOURCE_DIR ${CMAKE_SOURCE_DIR}")
# easy3D
#find_package(Easy3D REQUIRED
# PATHS ${CMAKE_SOURCE_DIR}/extlib/Easy3D
# NO_DEFAULT_PATH)
#find_package(rply CONFIG REQUIRED)
#find_package(CMinpack CONFIG REQUIRED)
#find_package(tinyfiledialogs CONFIG REQUIRED)
# opencv
@ -267,7 +298,7 @@ find_package(OpenCV REQUIRED) # 找到opencv库
# QGIS
#find_package(QGIS REQUIRED)
message("CMAKE_SOURCE_DIR ${CMAKE_SOURCE_DIR}")
#-----------------------------------------------------------------------------

View File

@ -1,7 +1,7 @@
#
set(CPACK_PACKAGE_NAME "${PROJECT_NAME}")
#
set(CPACK_PACKAGE_VENDOR "青岛数智船海科技有限公司")
set(CPACK_PACKAGE_VENDOR "中科卫星应用德清研究院")
#
set(CPACK_PACKAGE_DESCRIPTION_FILE "${PROJECT_SOURCE_DIR}/README.md")
#
@ -73,15 +73,15 @@ if(WIN32 OR MINGW)
#set(CPACK_NSIS_MUI_HEADERIMAGE "${CMAKE_SOURCE_DIR}/src/qrc/QUI/HEADERIMAGE.bmp")
set(CPACK_NSIS_MODIFY_PATH ON)
set(CPACK_NSIS_MUI_FINISHPAGE_RUN ON)
set(CPACK_NSIS_HELP_LINK "http://www.LAMPCAE.com/index.php?mod=document")
set(CPACK_NSIS_URL_INFO_ABOUT "http://www.LAMPCAE.com/index.php?mod=product")
set(CPACK_NSIS_MENU_LINKS "http://www.LAMPCAE.com/" "LAMPCAE网站")
set(CPACK_NSIS_HELP_LINK "")
set(CPACK_NSIS_URL_INFO_ABOUT "")
set(CPACK_NSIS_MENU_LINKS "" "CAE网站")
set(CPACK_NSIS_ENABLE_UNINSTALL_BEFORE_INSTALL ON)
elseif(WIX_EXECUTABLE)
list(APPEND CPACK_GENERATOR "WIX")
set(CPACK_WIX_PROPERTY_ARPCOMMENTS ${CPACK_PACKAGE_DESCRIPTION_SUMMARY})
set(CPACK_WIX_PROPERTY_ARPURLINFOABOUT "http://www.LAMPCAE.com/index.php?mod=product")
set(CPACK_WIX_PROPERTY_ARPHELPLINK "http://www.LAMPCAE.com/")
set(CPACK_WIX_PROPERTY_ARPURLINFOABOUT "")
set(CPACK_WIX_PROPERTY_ARPHELPLINK "")
endif ()
endif()

View File

@ -31,18 +31,13 @@ add_library(ALLBUILD
${_source}
)
#-----------------------------------------------------------------------------
#
#-----------------------------------------------------------------------------
list(APPEND _depend_library
# LAMPCAE
PluginCustomizer PluginMeshDataExchange PluginWBFZExchangePlugin PluginMotorBike
# PluginRasterTool
PluginCustomizer PluginMotorBike
PluginAddTree PluginMeshDataExchange PluginWBFZExchangePlugin PluginRasterTool
)

View File

@ -6,7 +6,7 @@ set(SOVERSION ${PROJECT_VERSION} ${PROJECT_VERSION_MAJOR} ${PROJECT_VERSION_MINO
#-----------------------------------------------------------------------------
list(APPEND _libraries BaseCppLibrary Common PythonModule SARibbonBar Settings DataProperty MeshData SelfDefObject Material Geometry BCBase ConfigOptions ParaClassFactory ModelData ModuleBase PostAlgorithm PostRenderData PostInterface PostCurveDataManager PostPlotWidget PostWidgets GeometryDataExchange ProjectTree ProjectTreeExtend GeometryCommand GeometryWidgets PluginManager GmshModule IO SolverControl MainWidgets UserGuidence)
list(APPEND _libraries PointCloudOperator)
list(APPEND _libraries json qcustomplot qhexedit qscintilla2 )
list(APPEND _libraries json qcustomplot qhexedit qscintilla2 )
#[[if(_WIN_)
list(APPEND _libraries XGenerateReport License)
@ -37,7 +37,6 @@ list(APPEND LAMPCAE_Runtimes_Libraries
OpenMeshCore OpenMeshTools
)
foreach(_library ${_libraries})
add_subdirectory(${_library})
@ -49,9 +48,6 @@ foreach(_library ${_libraries})
BUILD_WITH_INSTALL_RPATH ON
INSTALL_RPATH "${_lib_rpath}"
INSTALL_RPATH_USE_LINK_PATH ON
#POSITION_INDEPENDENT_CODE 1
#OUTPUT_NAME $<LOWER_CASE:${_library}>
#DEBUG_POSTFIX "_d"
VERSION ${PROJECT_VERSION} SOVERSION ${PROJECT_VERSION_MAJOR}
FOLDER Modules
)
@ -61,6 +57,10 @@ foreach(_library ${_libraries})
endforeach()
#-----------------------------------------------------------------------------
# addtree
#-----------------------------------------------------------------------------
### Configuration
#-----------------------------------------------------------------------------
#
@ -76,9 +76,6 @@ foreach(_TestPlugin ${_TestPlugins})
BUILD_WITH_INSTALL_RPATH ON
INSTALL_RPATH "${_lib_rpath}"
INSTALL_RPATH_USE_LINK_PATH ON
#POSITION_INDEPENDENT_CODE 1
#OUTPUT_NAME $<LOWER_CASE:${_library}>
#DEBUG_POSTFIX "_d"
VERSION ${PROJECT_VERSION} SOVERSION ${PROJECT_VERSION_MAJOR}
FOLDER Modules
)
@ -92,12 +89,11 @@ endforeach()
#-----------------------------------------------------------------------------
install(
TARGETS ${_libraries} ${PROJECT_NAME}
#ARCHIVE DESTINATION ${INSTALL_LIBDIR} COMPONENT lib
RUNTIME DESTINATION ${INSTALL_BINDIR} COMPONENT bin
LIBRARY DESTINATION ${INSTALL_LIBDIR} COMPONENT lib
)
list(APPEND _plugins PluginCustomizer PluginMeshDataExchange PluginWBFZExchangePlugin PluginMotorBike PluginRasterTool )
list(APPEND _plugins PluginAddTree PluginCustomizer PluginMeshDataExchange PluginWBFZExchangePlugin PluginMotorBike PluginRasterTool )
foreach(_plugin ${_plugins})
list(APPEND LAMPCAE_Runtimes_Libraries ${LAMPCAE_${_plugin}_Runtimes_Libraries})

View File

@ -15,7 +15,6 @@ file(GLOB _cpp "*.cpp")
add_library(Common
${_headers}
${_cpp}
)
#-----------------------------------------------------------------------------

View File

@ -109,6 +109,9 @@
#include "PointCloudOperator/MeshOpearatorCommon.h"
#include "MainWidgets/fekocadTaskinit.h"
#include "MainWindow/dialogpointcloudscane.h"
#include "MainWindow/soilsurface3dmeasurementsystem.h"
namespace GUI {
MainWindow::MainWindow(bool useRibbon)
: SARibbonMainWindow(nullptr, useRibbon)
@ -465,6 +468,7 @@ namespace GUI {
SLOT(on_actionLoadGeometricCorrectionFile_triggereds()));
connect(_ui->actionLoadRadioModelFile, SIGNAL(triggered()), this,
SLOT(on_actionLoadRadioModelFile_triggereds()));
connect(_ui->actionAddTree,SIGNAL(triggered()),this,SLOT(on_actionAddTree_triggereds()));
// 网格操作
connect(_ui->actionMeshDelete, SIGNAL(triggered()), this, SLOT(on_deleteMesh()));
@ -490,14 +494,13 @@ namespace GUI {
connect(_ui->actionCreateLoadModelScript, SIGNAL(triggered()), this,
SLOT(on_actionCreateLoadModelScript()));
connect(_ui->actionCreateCADModel, SIGNAL(triggered()), this,
connect(_ui->actionCreateCADModel, SIGNAL(triggered()), this,
SLOT(on_actionCreateCADModel()));
connect(_ui->actionEditSelectDialog, SIGNAL(triggered()), this,
connect(_ui->actionEditSelectDialog, SIGNAL(triggered()), this,
SLOT(on_actionEditSelectDialog()));
connect(_ui->action_ForestSance, SIGNAL(triggered()), this,SLOT(on_action_ForestSance()));
connect(_ui->action_soilSurfaceScane, SIGNAL(triggered()), this,SLOT(on_action_soilSurfaceScane()));
}
void MainWindow::registerMoudel()
@ -515,9 +518,6 @@ namespace GUI {
_processWindow = new MainWidget::ProcessWindow(this);
_processWindow->setAllowedAreas(Qt::BottomDockWidgetArea | Qt::TopDockWidgetArea);
addDockWidget(Qt::BottomDockWidgetArea, _processWindow);
}
Ui::MainWindowRibbon* MainWindow::getUi()
@ -2092,5 +2092,15 @@ namespace GUI {
selectNodeShow->initSelectNodeShow(this->getSubWindowManager()->getPreWindow()->getSelectItems(),this->getSubWindowManager()->getPreWindow()->getSelectModel()) ;
selectNodeShow->show();
}
void MainWindow::on_actionAddTree_triggereds() {
emit this->on_actionAddTreeClickedSIG(this);
}
void MainWindow::on_action_ForestSance() {
WBFZEquipment::DialogPointCloudScane* dialogPointCloudScane=new WBFZEquipment::DialogPointCloudScane(this);
dialogPointCloudScane->exec();
}
void MainWindow::on_action_soilSurfaceScane() {
WBFZEquipment::SoilSurface3DMeasurementSystem* dlg=new WBFZEquipment::SoilSurface3DMeasurementSystem(this);
dlg->exec();
}
} // namespace GUI

View File

@ -162,6 +162,9 @@ namespace GUI {
signals:
// 网格操作
void on_deleteMeshSIGNAL(GUI::MainWindow* m);
void on_copyMeshSIGNAL(GUI::MainWindow* m);
@ -361,6 +364,9 @@ namespace GUI {
void actionGenerateImportModelScript(int TaskID,GUI::MainWindow* m,QStringList stlPath,QStringList geoList,QString scriptPath);
void on_actionAddTreeClickedSIG(GUI::MainWindow* m);
public slots:
@ -440,6 +446,7 @@ namespace GUI {
void on_actionLoadRhounessPointCloudFile_triggereds();
void on_actionLoadGeometricCorrectionFile_triggereds();
void on_actionLoadRadioModelFile_triggereds();
void on_actionAddTree_triggereds();
// 网格操作
void on_deleteMesh();
@ -538,6 +545,9 @@ namespace GUI {
void on_MeshToGeo(MeshData::MeshKernal *k);
void on_action_generatorWaterPlane();
void on_action_ForestSance();
void on_action_soilSurfaceScane();
private:
/*初始化Menu*/
// void initMenu();

View File

@ -9,7 +9,7 @@
<rect>
<x>0</x>
<y>0</y>
<width>1156</width>
<width>1321</width>
<height>900</height>
</rect>
</property>
@ -272,7 +272,7 @@
<rect>
<x>0</x>
<y>0</y>
<width>1156</width>
<width>1321</width>
<height>26</height>
</rect>
</property>
@ -570,6 +570,7 @@
<string>森林目标制备</string>
</property>
<addaction name="actionLoadPreForestMeshFile"/>
<addaction name="actionAddTree"/>
<addaction name="separator"/>
<addaction name="actionGeoProcess"/>
<addaction name="actionMeshProcess"/>
@ -1110,37 +1111,16 @@
<addaction name="ProcessFlow_MenuVegetationScene"/>
<addaction name="separator"/>
</widget>
<widget class="QMenu" name="menuTargetWBZB">
<property name="title">
<string>目标与场景制备子系统专用软件</string>
<string>目标与场景制备子系统</string>
</property>
<widget class="QMenu" name="WBZB_MenuForestTarget">
<property name="title">
<string>森林目标制备模块</string>
</property>
<addaction name="actionLoadPreForestMeshFile"/>
<addaction name="actionAddTree"/>
<addaction name="separator"/>
<addaction name="actionGeoProcess"/>
<addaction name="actionMeshProcess"/>
@ -1266,6 +1246,13 @@
<addaction name="separator"/>
<addaction name="actionExportMesh"/>
</widget>
<widget class="QMenu" name="menu">
<property name="title">
<string>硬件设备</string>
</property>
<addaction name="action_ForestSance"/>
<addaction name="action_soilSurfaceScane"/>
</widget>
<addaction name="WBZB_MenuForestTarget"/>
<addaction name="WBZB_MenuCropTarget"/>
<addaction name="WBZB_MenuGrasslandTarget"/>
@ -1281,20 +1268,11 @@
<addaction name="WBZB_MenuWaterBodyScene"/>
<addaction name="WBZB_MenuVegetationScene"/>
<addaction name="separator"/>
<addaction name="menu"/>
</widget>
<widget class="QMenu" name="menuTargetWBCL">
<property name="title">
<string>特性测量子系统专用软件</string>
<string>特性测量子系统</string>
</property>
<widget class="QMenu" name="WBCL_MenuForestTarget">
<property name="title">
@ -1467,14 +1445,9 @@
<addaction name="WBCL_MenuVegetationScene"/>
<addaction name="separator"/>
</widget>
<widget class="QMenu" name="menuTargetWBFZ">
<property name="title">
<string>仿真分析子系统专用软件</string>
<string>仿真分析子系统</string>
</property>
<widget class="QMenu" name="WBFZ_MenuForestTarget">
<property name="title">
@ -1635,21 +1608,16 @@
<addaction name="WBFZ_MenuVegetationScene"/>
<addaction name="separator"/>
</widget>
<addaction name="menuFile"/>
<addaction name="menuTargetProcessFlow"/>
<addaction name="menuTargetWBZB"/>
<addaction name="menuTargetWBCL"/>
<addaction name="menuTargetWBFZ"/>
<addaction name="menuView"/>
<addaction name="menuGeometry"/>
<addaction name="menuMesher"/>
<addaction name="menuPointCloud"/>
<addaction name="menuFEKOSimulation"/>
<addaction name="menuTargetProcessFlow"/>
<addaction name="menuTargetWBZB"/>
<addaction name="menuTargetWBCL"/>
<addaction name="menuTargetWBFZ"/>
<addaction name="menuSolve"/>
<addaction name="menuWindows"/>
<addaction name="menuSettings"/>
@ -1735,6 +1703,14 @@
<string>加载预制森林网格</string>
</property>
</action>
<action name="actionAddTree">
<property name="enabled">
<bool>true</bool>
</property>
<property name="text">
<string>点云构树</string>
</property>
</action>
<action name="actionLoadPreCropMeshFile">
<property name="text">
<string>加载预制农作物网格数据</string>
@ -3338,6 +3314,16 @@
<string>EditSelectDialog</string>
</property>
</action>
<action name="action_ForestSance">
<property name="text">
<string>植被场景检测装置参数设置</string>
</property>
</action>
<action name="action_soilSurfaceScane">
<property name="text">
<string>土壤表面扫描仪</string>
</property>
</action>
</widget>
<resources>
<include location="../qrc/qianfan.qrc"/>

View File

@ -11,7 +11,7 @@
// resolved
#include "dialogpointcloudscane.h"
#include "ui_DialogPointCloudScane.h"
#include "ui_dialogpointcloudscane.h"
namespace WBFZEquipment {
DialogPointCloudScane::DialogPointCloudScane(QWidget* parent)

View File

@ -9,7 +9,7 @@
#ifndef LAMPCAE_DIALOGPOINTCLOUDSCANE_H
#define LAMPCAE_DIALOGPOINTCLOUDSCANE_H
#include "MainWindowAPI.h"
#include <QDialog>
namespace WBFZEquipment {
@ -19,7 +19,7 @@ namespace WBFZEquipment {
}
QT_END_NAMESPACE
class DialogPointCloudScane : public QDialog {
class MAINWINDOWAPI DialogPointCloudScane : public QDialog {
Q_OBJECT
public:

View File

@ -0,0 +1,129 @@
<?xml version="1.0" encoding="UTF-8"?>
<ui version="4.0">
<class>WBFZEquipment::DialogPointCloudScane</class>
<widget class="QDialog" name="WBFZEquipment::DialogPointCloudScane">
<property name="geometry">
<rect>
<x>0</x>
<y>0</y>
<width>499</width>
<height>384</height>
</rect>
</property>
<property name="windowTitle">
<string>植被场景检测装置</string>
</property>
<widget class="QPushButton" name="btnStartScan">
<property name="geometry">
<rect>
<x>310</x>
<y>250</y>
<width>75</width>
<height>71</height>
</rect>
</property>
<property name="text">
<string>开始扫描</string>
</property>
</widget>
<widget class="QGroupBox" name="groupBox">
<property name="geometry">
<rect>
<x>34</x>
<y>220</y>
<width>261</width>
<height>131</height>
</rect>
</property>
<property name="title">
<string>参数项</string>
</property>
<layout class="QGridLayout" name="gridLayout">
<item row="0" column="0">
<widget class="QLabel" name="label">
<property name="text">
<string>水平点扫描点位</string>
</property>
</widget>
</item>
<item row="0" column="1">
<widget class="QLineEdit" name="lineEdit"/>
</item>
<item row="1" column="0">
<widget class="QLabel" name="label_2">
<property name="text">
<string>垂直点扫描点位</string>
</property>
</widget>
</item>
<item row="1" column="1">
<widget class="QLineEdit" name="lineEdit_2"/>
</item>
</layout>
</widget>
<widget class="QWidget" name="gridLayoutWidget">
<property name="geometry">
<rect>
<x>50</x>
<y>80</y>
<width>381</width>
<height>141</height>
</rect>
</property>
<layout class="QGridLayout" name="gridLayout_2">
<item row="0" column="0">
<widget class="QPushButton" name="btnDown">
<property name="text">
<string>垂直向下运动</string>
</property>
</widget>
</item>
<item row="1" column="0">
<widget class="QPushButton" name="btnUp">
<property name="text">
<string>垂直向上运动</string>
</property>
</widget>
</item>
<item row="0" column="1">
<widget class="QPushButton" name="btnForward">
<property name="text">
<string>平台前进</string>
</property>
</widget>
</item>
<item row="1" column="1">
<widget class="QPushButton" name="btnBackward">
<property name="text">
<string>平台后退</string>
</property>
</widget>
</item>
</layout>
</widget>
<widget class="QLabel" name="label_3">
<property name="geometry">
<rect>
<x>80</x>
<y>20</y>
<width>301</width>
<height>41</height>
</rect>
</property>
<property name="font">
<font>
<family>Agency FB</family>
<pointsize>16</pointsize>
</font>
</property>
<property name="text">
<string>植被场景检测装置</string>
</property>
<property name="alignment">
<set>Qt::AlignCenter</set>
</property>
</widget>
</widget>
<resources/>
<connections/>
</ui>

View File

@ -6,7 +6,7 @@
// "ui_SoilSurface3DMeasurementSystem.h" resolved
#include "soilsurface3dmeasurementsystem.h"
#include "ui_SoilSurface3DMeasurementSystem.h"
#include "ui_soilsurface3dmeasurementsystem.h"
namespace WBFZEquipment {
SoilSurface3DMeasurementSystem::SoilSurface3DMeasurementSystem(QWidget* parent)

View File

@ -4,7 +4,7 @@
#ifndef LAMPCAE_SOILSURFACE3DMEASUREMENTSYSTEM_H
#define LAMPCAE_SOILSURFACE3DMEASUREMENTSYSTEM_H
#include "MainWindowAPI.h"
#include <QDialog>
namespace WBFZEquipment {
@ -14,7 +14,7 @@ namespace WBFZEquipment {
}
QT_END_NAMESPACE
class SoilSurface3DMeasurementSystem : public QDialog {
class MAINWINDOWAPI SoilSurface3DMeasurementSystem : public QDialog {
Q_OBJECT
public:

View File

@ -2,6 +2,7 @@
#include <QDir>
#include <QDebug>
#include <QRandomGenerator>
#include <QDateTime>
bool RemoveDir(QString fullpath)
{
@ -46,4 +47,10 @@ QString MODULEBASEAPI generateRandomString(int length) {
randomString.append(possibleCharacters.at(index));
}
return randomString;
}
}
QString MODULEBASEAPI generateRandomStringWithTime()
{
QString randomString = generateRandomString(8);
QString formattedTime = QDateTime::currentDateTime().toString("yyyyMMddHHmmsszzz");
return randomString + formattedTime;
}

View File

@ -12,6 +12,9 @@ extern "C"
QString MODULEBASEAPI doubleToString(double v, int acc);
// 生成随机字符串
QString MODULEBASEAPI generateRandomString(int length);
// 生成随机字符串 带有时间戳
QString MODULEBASEAPI generateRandomStringWithTime();
}
#endif

View File

@ -1,13 +0,0 @@
cmake_minimum_required(VERSION 3.1)
add_subdirectory("glew")
add_subdirectory("glfw")
add_subdirectory("tetgen")
add_subdirectory("kd_tree")
add_subdirectory("cminpack")
add_subdirectory("optimizer_lm")
add_subdirectory("easy3d")
add_subdirectory("imgui")
add_subdirectory("tinyfiledialogs")
add_subdirectory("rply")

View File

@ -1,69 +0,0 @@
cmake_minimum_required(VERSION 3.1)
get_filename_component(MODULE_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
set(PROJECT_NAME 3rd_${MODULE_NAME})
project(${PROJECT_NAME})
add_library(${PROJECT_NAME} STATIC
chkder.c
chkder_.c
covar.c
covar1.c
covar_.c
dogleg.c
dogleg_.c
dpmpar.c
dpmpar_.c
enorm.c
enorm_.c
fdjac1.c
fdjac1_.c
fdjac2.c
fdjac2_.c
hybrd.c
hybrd1.c
hybrd1_.c
hybrd_.c
hybrj.c
hybrj1.c
hybrj1_.c
hybrj_.c
lmder.c
lmder1.c
lmder1_.c
lmder_.c
lmdif.c
lmdif1.c
lmdif1_.c
lmdif_.c
lmpar.c
lmpar_.c
lmstr.c
lmstr1.c
lmstr1_.c
lmstr_.c
qform.c
qform_.c
qrfac.c
qrfac_.c
qrsolv.c
qrsolv_.c
r1mpyq.c
r1mpyq_.c
r1updt.c
r1updt_.c
rwupdt.c
rwupdt_.c
cminpack.h
cminpackP.h
minpack.h
minpackP.h
)
set_target_properties(${PROJECT_NAME} PROPERTIES
FOLDER "3rd_party")
target_include_directories(${PROJECT_NAME} PRIVATE ${EASY3D_cminpack_INCLUDE_DIR})

View File

@ -1,52 +0,0 @@
Minpack Copyright Notice (1999) University of Chicago. All rights reserved
Redistribution and use in source and binary forms, with or
without modification, are permitted provided that the
following conditions are met:
1. Redistributions of source code must retain the above
copyright notice, this list of conditions and the following
disclaimer.
2. 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.
3. The end-user documentation included with the
redistribution, if any, must include the following
acknowledgment:
"This product includes software developed by the
University of Chicago, as Operator of Argonne National
Laboratory.
Alternately, this acknowledgment may appear in the software
itself, if and wherever such third-party acknowledgments
normally appear.
4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
BE CORRECTED.
5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
(INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
POSSIBILITY OF SUCH LOSS OR DAMAGES.

View File

@ -1,159 +0,0 @@
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
#define log10e 0.43429448190325182765
#define factor 100.
/* Table of constant values */
__cminpack_attr__
void __cminpack_func__(chkder)(int m, int n, const real *x,
real *fvec, real *fjac, int ldfjac, real *xp,
real *fvecp, int mode, real *err)
{
/* Local variables */
int i, j;
real eps, epsf, temp, epsmch;
real epslog;
/* ********** */
/* subroutine chkder */
/* this subroutine checks the gradients of m nonlinear functions */
/* in n variables, evaluated at a point x, for consistency with */
/* the functions themselves. the user must call chkder twice, */
/* first with mode = 1 and then with mode = 2. */
/* mode = 1. on input, x must contain the point of evaluation. */
/* on output, xp is set to a neighboring point. */
/* mode = 2. on input, fvec must contain the functions and the */
/* rows of fjac must contain the gradients */
/* of the respective functions each evaluated */
/* at x, and fvecp must contain the functions */
/* evaluated at xp. */
/* on output, err contains measures of correctness of */
/* the respective gradients. */
/* the subroutine does not perform reliably if cancellation or */
/* rounding errors cause a severe loss of significance in the */
/* evaluation of a function. therefore, none of the components */
/* of x should be unusually small (in particular, zero) or any */
/* other value which may cause loss of significance. */
/* the subroutine statement is */
/* subroutine chkder(m,n,x,fvec,fjac,ldfjac,xp,fvecp,mode,err) */
/* where */
/* 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. */
/* x is an input array of length n. */
/* fvec is an array of length m. on input when mode = 2, */
/* fvec must contain the functions evaluated at x. */
/* fjac is an m by n array. on input when mode = 2, */
/* the rows of fjac must contain the gradients of */
/* the respective functions evaluated at x. */
/* ldfjac is a positive integer input parameter not less than m */
/* which specifies the leading dimension of the array fjac. */
/* xp is an array of length n. on output when mode = 1, */
/* xp is set to a neighboring point of x. */
/* fvecp is an array of length m. on input when mode = 2, */
/* fvecp must contain the functions evaluated at xp. */
/* mode is an integer input variable set to 1 on the first call */
/* and 2 on the second. other values of mode are equivalent */
/* to mode = 1. */
/* err is an array of length m. on output when mode = 2, */
/* err contains measures of correctness of the respective */
/* gradients. if there is no severe loss of significance, */
/* then if err(i) is 1.0 the i-th gradient is correct, */
/* while if err(i) is 0.0 the i-th gradient is incorrect. */
/* for values of err between 0.0 and 1.0, the categorization */
/* is less certain. in general, a value of err(i) greater */
/* than 0.5 indicates that the i-th gradient is probably */
/* correct, while a value of err(i) less than 0.5 indicates */
/* that the i-th gradient is probably incorrect. */
/* subprograms called */
/* minpack supplied ... dpmpar */
/* fortran supplied ... dabs,dlog10,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(1);
eps = sqrt(epsmch);
if (mode != 2) {
/* mode = 1. */
for (j = 0; j < n; ++j) {
temp = eps * fabs(x[j]);
if (temp == 0.) {
temp = eps;
}
xp[j] = x[j] + temp;
}
return;
}
/* mode = 2. */
epsf = factor * epsmch;
epslog = log10e * log(eps);
for (i = 0; i < m; ++i) {
err[i] = 0.;
}
for (j = 0; j < n; ++j) {
temp = fabs(x[j]);
if (temp == 0.) {
temp = 1.;
}
for (i = 0; i < m; ++i) {
err[i] += temp * fjac[i + j * ldfjac];
}
}
for (i = 0; i < m; ++i) {
temp = 1.;
if (fvec[i] != 0. && fvecp[i] != 0. &&
fabs(fvecp[i] - fvec[i]) >= epsf * fabs(fvec[i]))
{
temp = eps * fabs((fvecp[i] - fvec[i]) / eps - err[i])
/ (fabs(fvec[i]) +
fabs(fvecp[i]));
}
err[i] = 1.;
if (temp > epsmch && temp < eps) {
err[i] = (log10e * log(temp) - epslog) / epslog;
}
if (temp >= eps) {
err[i] = 0.;
}
}
/* last card of subroutine chkder. */
} /* chkder_ */

View File

@ -1,198 +0,0 @@
/* chkder.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
#define log10e 0.43429448190325182765
#define factor 100.
/* Table of constant values */
__minpack_attr__
void __minpack_func__(chkder)(const int *m, const int *n, const real *x,
real *fvec, real *fjac, const int *ldfjac, real *xp,
real *fvecp, const int *mode, real *err)
{
/* Initialized data */
const int c__1 = 1;
/* System generated locals */
int fjac_dim1, fjac_offset, i__1, i__2;
/* Local variables */
int i__, j;
real eps, epsf, temp, epsmch;
real epslog;
/* ********** */
/* subroutine chkder */
/* this subroutine checks the gradients of m nonlinear functions */
/* in n variables, evaluated at a point x, for consistency with */
/* the functions themselves. the user must call chkder twice, */
/* first with mode = 1 and then with mode = 2. */
/* mode = 1. on input, x must contain the point of evaluation. */
/* on output, xp is set to a neighboring point. */
/* mode = 2. on input, fvec must contain the functions and the */
/* rows of fjac must contain the gradients */
/* of the respective functions each evaluated */
/* at x, and fvecp must contain the functions */
/* evaluated at xp. */
/* on output, err contains measures of correctness of */
/* the respective gradients. */
/* the subroutine does not perform reliably if cancellation or */
/* rounding errors cause a severe loss of significance in the */
/* evaluation of a function. therefore, none of the components */
/* of x should be unusually small (in particular, zero) or any */
/* other value which may cause loss of significance. */
/* the subroutine statement is */
/* subroutine chkder(m,n,x,fvec,fjac,ldfjac,xp,fvecp,mode,err) */
/* where */
/* 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. */
/* x is an input array of length n. */
/* fvec is an array of length m. on input when mode = 2, */
/* fvec must contain the functions evaluated at x. */
/* fjac is an m by n array. on input when mode = 2, */
/* the rows of fjac must contain the gradients of */
/* the respective functions evaluated at x. */
/* ldfjac is a positive integer input parameter not less than m */
/* which specifies the leading dimension of the array fjac. */
/* xp is an array of length n. on output when mode = 1, */
/* xp is set to a neighboring point of x. */
/* fvecp is an array of length m. on input when mode = 2, */
/* fvecp must contain the functions evaluated at xp. */
/* mode is an integer input variable set to 1 on the first call */
/* and 2 on the second. other values of mode are equivalent */
/* to mode = 1. */
/* err is an array of length m. on output when mode = 2, */
/* err contains measures of correctness of the respective */
/* gradients. if there is no severe loss of significance, */
/* then if err(i) is 1.0 the i-th gradient is correct, */
/* while if err(i) is 0.0 the i-th gradient is incorrect. */
/* for values of err between 0.0 and 1.0, the categorization */
/* is less certain. in general, a value of err(i) greater */
/* than 0.5 indicates that the i-th gradient is probably */
/* correct, while a value of err(i) less than 0.5 indicates */
/* that the i-th gradient is probably incorrect. */
/* subprograms called */
/* minpack supplied ... dpmpar */
/* fortran supplied ... dabs,dlog10,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--err;
--fvecp;
--fvec;
--xp;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(dpmpar)(&c__1);
eps = sqrt(epsmch);
if (*mode == 2) {
goto L20;
}
/* mode = 1. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
temp = eps * fabs(x[j]);
if (temp == 0.) {
temp = eps;
}
xp[j] = x[j] + temp;
/* L10: */
}
/* goto L70; */
return;
L20:
/* mode = 2. */
epsf = factor * epsmch;
epslog = log10e * log(eps);
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
err[i__] = 0.;
/* L30: */
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
temp = fabs(x[j]);
if (temp == 0.) {
temp = 1.;
}
i__2 = *m;
for (i__ = 1; i__ <= i__2; ++i__) {
err[i__] += temp * fjac[i__ + j * fjac_dim1];
/* L40: */
}
/* L50: */
}
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
temp = 1.;
if (fvec[i__] != 0. && fvecp[i__] != 0. && fabs(fvecp[i__] -
fvec[i__]) >= epsf * fabs(fvec[i__]))
{
temp = eps * fabs((fvecp[i__] - fvec[i__]) / eps - err[i__])
/ (fabs(fvec[i__]) +
fabs(fvecp[i__]));
}
err[i__] = 1.;
if (temp > epsmch && temp < eps) {
err[i__] = (log10e * log(temp) - epslog) / epslog;
}
if (temp >= eps) {
err[i__] = 0.;
}
/* L60: */
}
/* L70: */
/* return 0; */
/* last card of subroutine chkder. */
} /* chkder_ */

View File

@ -1,379 +0,0 @@
/* Header file for cminpack, by Frederic Devernay.
The documentation for all functions can be found in the file
minpack-documentation.txt from the distribution, or in the source
code of each function. */
#ifndef __CMINPACK_H__
#define __CMINPACK_H__
/* The default floating-point type is "double" for C/C++ and "float" for CUDA,
but you can change this by defining one of the following symbols when
compiling the library, and before including cminpack.h when using it:
__cminpack_long_double__ for long double (requires compiler support)
__cminpack_double__ for double
__cminpack_float__ for float
__cminpack_half__ for half from the OpenEXR library (in this case, you must
compile cminpack with a C++ compiler)
*/
#ifdef __cminpack_long_double__
#define __cminpack_real__ long double
#endif
#ifdef __cminpack_double__
#define __cminpack_real__ double
#endif
#ifdef __cminpack_float__
#define __cminpack_real__ float
#endif
#ifdef __cminpack_half__
#include <OpenEXR/half.h>
#define __cminpack_real__ half
#endif
#ifdef __cplusplus
extern "C" {
#endif /* __cplusplus */
/* Cmake will define cminpack_EXPORTS on Windows when it
configures to build a shared library. If you are going to use
another build system on windows or create the visual studio
projects by hand you need to define cminpack_EXPORTS when
building a DLL on windows.
*/
#if defined (__GNUC__)
#define CMINPACK_DECLSPEC_EXPORT __declspec(__dllexport__)
#define CMINPACK_DECLSPEC_IMPORT __declspec(__dllimport__)
#endif
#if defined (_MSC_VER) || defined (__BORLANDC__)
#define CMINPACK_DECLSPEC_EXPORT __declspec(dllexport)
#define CMINPACK_DECLSPEC_IMPORT __declspec(dllimport)
#endif
#ifdef __WATCOMC__
#define CMINPACK_DECLSPEC_EXPORT __export
#define CMINPACK_DECLSPEC_IMPORT __import
#endif
#ifdef __IBMC__
#define CMINPACK_DECLSPEC_EXPORT _Export
#define CMINPACK_DECLSPEC_IMPORT _Import
#endif
#if !defined(CMINPACK_NO_DLL) && (defined(__WIN32__) || defined(WIN32) || defined (_WIN32))
#if defined(cminpack_EXPORTS) || defined(CMINPACK_EXPORTS) || defined(CMINPACK_DLL_EXPORTS)
#define CMINPACK_EXPORT //CMINPACK_DECLSPEC_EXPORT
#else
#define CMINPACK_EXPORT //CMINPACK_DECLSPEC_IMPORT
#endif /* cminpack_EXPORTS */
#else /* defined (_WIN32) */
#define CMINPACK_EXPORT
#endif
#if defined(__CUDA_ARCH__) || defined(__CUDACC__)
#define __cminpack_attr__ __device__
#ifndef __cminpack_real__
#define __cminpack_float__
#define __cminpack_real__ float
#endif
#define __cminpack_type_fcn_nn__ __cminpack_attr__ int fcn_nn
#define __cminpack_type_fcnder_nn__ __cminpack_attr__ int fcnder_nn
#define __cminpack_type_fcn_mn__ __cminpack_attr__ int fcn_mn
#define __cminpack_type_fcnder_mn__ __cminpack_attr__ int fcnder_mn
#define __cminpack_type_fcnderstr_mn__ __cminpack_attr__ int fcnderstr_mn
#define __cminpack_decl_fcn_nn__
#define __cminpack_decl_fcnder_nn__
#define __cminpack_decl_fcn_mn__
#define __cminpack_decl_fcnder_mn__
#define __cminpack_decl_fcnderstr_mn__
#define __cminpack_param_fcn_nn__
#define __cminpack_param_fcnder_nn__
#define __cminpack_param_fcn_mn__
#define __cminpack_param_fcnder_mn__
#define __cminpack_param_fcnderstr_mn__
#else
#define __cminpack_attr__
#ifndef __cminpack_real__
#define __cminpack_double__
#define __cminpack_real__ double
#endif
#define __cminpack_type_fcn_nn__ typedef int (*cminpack_func_nn)
#define __cminpack_type_fcnder_nn__ typedef int (*cminpack_funcder_nn)
#define __cminpack_type_fcn_mn__ typedef int (*cminpack_func_mn)
#define __cminpack_type_fcnder_mn__ typedef int (*cminpack_funcder_mn)
#define __cminpack_type_fcnderstr_mn__ typedef int (*cminpack_funcderstr_mn)
#define __cminpack_decl_fcn_nn__ cminpack_func_nn fcn_nn,
#define __cminpack_decl_fcnder_nn__ cminpack_funcder_nn fcnder_nn,
#define __cminpack_decl_fcn_mn__ cminpack_func_mn fcn_mn,
#define __cminpack_decl_fcnder_mn__ cminpack_funcder_mn fcnder_mn,
#define __cminpack_decl_fcnderstr_mn__ cminpack_funcderstr_mn fcnderstr_mn,
#define __cminpack_param_fcn_nn__ fcn_nn,
#define __cminpack_param_fcnder_nn__ fcnder_nn,
#define __cminpack_param_fcn_mn__ fcn_mn,
#define __cminpack_param_fcnder_mn__ fcnder_mn,
#define __cminpack_param_fcnderstr_mn__ fcnderstr_mn,
#endif
#ifdef __cminpack_double__
#define __cminpack_func__(func) func
#endif
#ifdef __cminpack_long_double__
#define __cminpack_func__(func) ld ## func
#endif
#ifdef __cminpack_float__
#define __cminpack_func__(func) s ## func
#endif
#ifdef __cminpack_half__
#define __cminpack_func__(func) h ## func
#endif
/* Declarations for minpack */
/* Function types: */
/* The first argument can be used to store extra function parameters, thus */
/* avoiding the use of global variables. */
/* the iflag parameter is input-only (with respect to the FORTRAN */
/* version), the output iflag value is the return value of the function. */
/* If iflag=0, the function shoulkd just print the current values (see */
/* the nprint parameters below). */
/* for hybrd1 and hybrd: */
/* calculate the functions at x and */
/* return this vector in fvec. */
/* return a negative value to terminate hybrd1/hybrd */
__cminpack_type_fcn_nn__(void *p, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec, int iflag );
/* for hybrj1 and hybrj */
/* 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 a negative value to terminate hybrj1/hybrj */
__cminpack_type_fcnder_nn__(void *p, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
int ldfjac, int iflag );
/* for lmdif1 and lmdif */
/* calculate the functions at x and */
/* return this vector in fvec. */
/* if iflag = 1 the result is used to compute the residuals. */
/* if iflag = 2 the result is used to compute the Jacobian by finite differences. */
/* Jacobian computation requires exactly n function calls with iflag = 2. */
/* return a negative value to terminate lmdif1/lmdif */
__cminpack_type_fcn_mn__(void *p, int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec,
int iflag );
/* for lmder1 and lmder */
/* 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 a negative value to terminate lmder1/lmder */
__cminpack_type_fcnder_mn__(void *p, int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec,
__cminpack_real__ *fjac, int ldfjac, int iflag );
/* for lmstr1 and lmstr */
/* if iflag = 1 calculate the functions at x and */
/* return this vector in fvec. */
/* if iflag = i calculate the (i-1)-st row of the */
/* jacobian at x and return this vector in fjrow. */
/* return a negative value to terminate lmstr1/lmstr */
__cminpack_type_fcnderstr_mn__(void *p, int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec,
__cminpack_real__ *fjrow, int iflag );
/* MINPACK functions: */
/* the info parameter was removed from most functions: the return */
/* value of the function is used instead. */
/* The argument 'p' can be used to store extra function parameters, thus */
/* avoiding the use of global variables. You can also think of it as a */
/* 'this' pointer a la C++. */
/* find a zero of a system of N nonlinear functions in N variables by
a modification of the Powell hybrid method (Jacobian calculated by
a forward-difference approximation) */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(hybrd1)( __cminpack_decl_fcn_nn__
void *p, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ tol,
__cminpack_real__ *wa, int lwa );
/* find a zero of a system of N nonlinear functions in N variables by
a modification of the Powell hybrid method (Jacobian calculated by
a forward-difference approximation, more general). */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(hybrd)( __cminpack_decl_fcn_nn__
void *p, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ xtol, int maxfev,
int ml, int mu, __cminpack_real__ epsfcn, __cminpack_real__ *diag, int mode,
__cminpack_real__ factor, int nprint, int *nfev,
__cminpack_real__ *fjac, int ldfjac, __cminpack_real__ *r, int lr, __cminpack_real__ *qtf,
__cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3, __cminpack_real__ *wa4);
/* find a zero of a system of N nonlinear functions in N variables by
a modification of the Powell hybrid method (user-supplied Jacobian) */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(hybrj1)( __cminpack_decl_fcnder_nn__ void *p, int n, __cminpack_real__ *x,
__cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac, __cminpack_real__ tol,
__cminpack_real__ *wa, int lwa );
/* find a zero of a system of N nonlinear functions in N variables by
a modification of the Powell hybrid method (user-supplied Jacobian,
more general) */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(hybrj)( __cminpack_decl_fcnder_nn__ void *p, int n, __cminpack_real__ *x,
__cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac, __cminpack_real__ xtol,
int maxfev, __cminpack_real__ *diag, int mode, __cminpack_real__ factor,
int nprint, int *nfev, int *njev, __cminpack_real__ *r,
int lr, __cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2,
__cminpack_real__ *wa3, __cminpack_real__ *wa4 );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(Jacobian calculated by a forward-difference approximation) */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(lmdif1)( __cminpack_decl_fcn_mn__
void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ tol,
int *iwa, __cminpack_real__ *wa, int lwa );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(Jacobian calculated by a forward-difference approximation, more
general) */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(lmdif)( __cminpack_decl_fcn_mn__
void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ ftol,
__cminpack_real__ xtol, __cminpack_real__ gtol, int maxfev, __cminpack_real__ epsfcn,
__cminpack_real__ *diag, int mode, __cminpack_real__ factor, int nprint,
int *nfev, __cminpack_real__ *fjac, int ldfjac, int *ipvt,
__cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3,
__cminpack_real__ *wa4 );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(user-supplied Jacobian) */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(lmder1)( __cminpack_decl_fcnder_mn__
void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
int ldfjac, __cminpack_real__ tol, int *ipvt,
__cminpack_real__ *wa, int lwa );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(user-supplied Jacobian, more general) */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(lmder)( __cminpack_decl_fcnder_mn__
void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
int ldfjac, __cminpack_real__ ftol, __cminpack_real__ xtol, __cminpack_real__ gtol,
int maxfev, __cminpack_real__ *diag, int mode, __cminpack_real__ factor,
int nprint, int *nfev, int *njev, int *ipvt,
__cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3,
__cminpack_real__ *wa4 );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(user-supplied Jacobian, minimal storage) */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(lmstr1)( __cminpack_decl_fcnderstr_mn__ void *p, int m, int n,
__cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac,
__cminpack_real__ tol, int *ipvt, __cminpack_real__ *wa, int lwa );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(user-supplied Jacobian, minimal storage, more general) */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(lmstr)( __cminpack_decl_fcnderstr_mn__ void *p, int m,
int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
int ldfjac, __cminpack_real__ ftol, __cminpack_real__ xtol, __cminpack_real__ gtol,
int maxfev, __cminpack_real__ *diag, int mode, __cminpack_real__ factor,
int nprint, int *nfev, int *njev, int *ipvt,
__cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3,
__cminpack_real__ *wa4 );
__cminpack_attr__
void CMINPACK_EXPORT __cminpack_func__(chkder)( int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
int ldfjac, __cminpack_real__ *xp, __cminpack_real__ *fvecp, int mode,
__cminpack_real__ *err );
__cminpack_attr__
__cminpack_real__ CMINPACK_EXPORT __cminpack_func__(dpmpar)( int i );
__cminpack_attr__
__cminpack_real__ CMINPACK_EXPORT __cminpack_func__(enorm)( int n, const __cminpack_real__ *x );
/* compute a forward-difference approximation to the m by n jacobian
matrix associated with a specified problem of m functions in n
variables. */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(fdjac2)(__cminpack_decl_fcn_mn__
void *p, int m, int n, __cminpack_real__ *x, const __cminpack_real__ *fvec, __cminpack_real__ *fjac,
int ldfjac, __cminpack_real__ epsfcn, __cminpack_real__ *wa);
/* compute a forward-difference approximation to the n by n jacobian
matrix associated with a specified problem of n functions in n
variables. if the jacobian has a banded form, then function
evaluations are saved by only approximating the nonzero terms. */
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(fdjac1)(__cminpack_decl_fcn_nn__
void *p, int n, __cminpack_real__ *x, const __cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac,
int ml, int mu, __cminpack_real__ epsfcn, __cminpack_real__ *wa1,
__cminpack_real__ *wa2);
/* compute inverse(JtJ) after a run of lmdif or lmder. The covariance matrix is obtained
by scaling the result by enorm(y)**2/(m-n). If JtJ is singular and k = rank(J), the
pseudo-inverse is computed, and the result has to be scaled by enorm(y)**2/(m-k). */
__cminpack_attr__
void CMINPACK_EXPORT __cminpack_func__(covar)(int n, __cminpack_real__ *r, int ldr,
const int *ipvt, __cminpack_real__ tol, __cminpack_real__ *wa);
/* covar1 estimates the variance-covariance matrix:
C = sigma**2 (JtJ)**+
where (JtJ)**+ is the inverse of JtJ or the pseudo-inverse of JtJ (in case J does not have full rank),
and sigma**2 = fsumsq / (m - k)
where fsumsq is the residual sum of squares and k is the rank of J.
The function returns 0 if J has full rank, else the rank of J.
*/
__cminpack_attr__
int CMINPACK_EXPORT __cminpack_func__(covar1)(int m, int n, __cminpack_real__ fsumsq, __cminpack_real__ *r, int ldr,
const int *ipvt, __cminpack_real__ tol, __cminpack_real__ *wa);
/* internal MINPACK subroutines */
__cminpack_attr__
void __cminpack_func__(dogleg)(int n, const __cminpack_real__ *r, int lr,
const __cminpack_real__ *diag, const __cminpack_real__ *qtb, __cminpack_real__ delta, __cminpack_real__ *x,
__cminpack_real__ *wa1, __cminpack_real__ *wa2);
__cminpack_attr__
void __cminpack_func__(qrfac)(int m, int n, __cminpack_real__ *a, int
lda, int pivot, int *ipvt, int lipvt, __cminpack_real__ *rdiag,
__cminpack_real__ *acnorm, __cminpack_real__ *wa);
__cminpack_attr__
void __cminpack_func__(qrsolv)(int n, __cminpack_real__ *r, int ldr,
const int *ipvt, const __cminpack_real__ *diag, const __cminpack_real__ *qtb, __cminpack_real__ *x,
__cminpack_real__ *sdiag, __cminpack_real__ *wa);
__cminpack_attr__
void __cminpack_func__(qform)(int m, int n, __cminpack_real__ *q, int
ldq, __cminpack_real__ *wa);
__cminpack_attr__
void __cminpack_func__(r1updt)(int m, int n, __cminpack_real__ *s, int
ls, const __cminpack_real__ *u, __cminpack_real__ *v, __cminpack_real__ *w, int *sing);
__cminpack_attr__
void __cminpack_func__(r1mpyq)(int m, int n, __cminpack_real__ *a, int
lda, const __cminpack_real__ *v, const __cminpack_real__ *w);
__cminpack_attr__
void __cminpack_func__(lmpar)(int n, __cminpack_real__ *r, int ldr,
const int *ipvt, const __cminpack_real__ *diag, const __cminpack_real__ *qtb, __cminpack_real__ delta,
__cminpack_real__ *par, __cminpack_real__ *x, __cminpack_real__ *sdiag, __cminpack_real__ *wa1,
__cminpack_real__ *wa2);
__cminpack_attr__
void __cminpack_func__(rwupdt)(int n, __cminpack_real__ *r, int ldr,
const __cminpack_real__ *w, __cminpack_real__ *b, __cminpack_real__ *alpha, __cminpack_real__ *cos,
__cminpack_real__ *sin);
#ifdef __cplusplus
}
#endif /* __cplusplus */
#endif /* __CMINPACK_H__ */

View File

@ -1,58 +0,0 @@
/* Internal header file for cminpack, by Frederic Devernay. */
#ifndef __CMINPACKP_H__
#define __CMINPACKP_H__
#ifndef __CMINPACK_H__
#error "cminpackP.h in an internal cminpack header, and must be included after all other headers (including cminpack.h)"
#endif
#if (defined (USE_CBLAS) || defined (USE_LAPACK)) && !defined (__cminpack_double__)
#error "cminpack can use cblas and lapack only in double precision mode"
#endif
#ifdef USE_CBLAS
#ifdef __APPLE__
#include <Accelerate/Accelerate.h>
#else
#include <cblas.h>
#endif
#define __cminpack_enorm__(n,x) cblas_dnrm2(n,x,1)
#else
#define __cminpack_enorm__(n,x) __cminpack_func__(enorm)(n,x)
#endif
#ifdef USE_LAPACK
#ifdef __APPLE__
#include <Accelerate/Accelerate.h>
#else
#if defined(__LP64__) /* In LP64 match sizes with the 32 bit ABI */
typedef int __CLPK_integer;
typedef int __CLPK_logical;
typedef float __CLPK_real;
typedef double __CLPK_doublereal;
typedef __CLPK_logical (*__CLPK_L_fp)();
typedef int __CLPK_ftnlen;
#else
typedef long int __CLPK_integer;
typedef long int __CLPK_logical;
typedef float __CLPK_real;
typedef double __CLPK_doublereal;
typedef __CLPK_logical (*__CLPK_L_fp)();
typedef long int __CLPK_ftnlen;
#endif
//extern void dlartg_(double *f, double *g, double *cs, double *sn, double *r__);
int dlartg_(__CLPK_doublereal *f, __CLPK_doublereal *g, __CLPK_doublereal *cs,
__CLPK_doublereal *sn, __CLPK_doublereal *r__);
//extern void dgeqp3_(int *m, int *n, double *a, int *lda, int *jpvt, double *tau, double *work, int *lwork, int *info);
int dgeqp3_(__CLPK_integer *m, __CLPK_integer *n, __CLPK_doublereal *a, __CLPK_integer *
lda, __CLPK_integer *jpvt, __CLPK_doublereal *tau, __CLPK_doublereal *work, __CLPK_integer *lwork,
__CLPK_integer *info);
//extern void dgeqrf_(int *m, int *n, double *a, int *lda, double *tau, double *work, int *lwork, int *info);
int dgeqrf_(__CLPK_integer *m, __CLPK_integer *n, __CLPK_doublereal *a, __CLPK_integer *
lda, __CLPK_doublereal *tau, __CLPK_doublereal *work, __CLPK_integer *lwork, __CLPK_integer *info);
#endif
#endif
#include "minpackP.h"
#endif /* !__CMINPACKP_H__ */

View File

@ -1,155 +0,0 @@
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
void __cminpack_func__(covar)(int n, real *r, int ldr,
const int *ipvt, real tol, real *wa)
{
/* Local variables */
int i, j, k, l, ii, jj;
int sing;
real temp, tolr;
/* ********** */
/* subroutine covar */
/* given an m by n matrix a, the problem is to determine */
/* the covariance matrix corresponding to a, defined as */
/* t */
/* inverse(a *a) . */
/* 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 covar expects */
/* the full upper triangle of r and the permutation matrix p. */
/* the covariance matrix is then computed as */
/* t t */
/* p*inverse(r *r)*p . */
/* if a is nearly rank deficient, it may be desirable to compute */
/* the covariance matrix corresponding to the linearly independent */
/* columns of a. to define the numerical rank of a, covar uses */
/* the tolerance tol. if l is the largest integer such that */
/* abs(r(l,l)) .gt. tol*abs(r(1,1)) , */
/* then covar computes the covariance matrix corresponding to */
/* the first l columns of r. for k greater than l, column */
/* and row ipvt(k) of the covariance matrix are set to zero. */
/* the subroutine statement is */
/* subroutine covar(n,r,ldr,ipvt,tol,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 */
/* r contains the square symmetric covariance matrix. */
/* 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. */
/* tol is a nonnegative input variable used to define the */
/* numerical rank of a in the manner described above. */
/* wa is a work array of length n. */
/* subprograms called */
/* fortran-supplied ... dabs */
/* argonne national laboratory. minpack project. august 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
tolr = tol * fabs(r[0]);
/* form the inverse of r in the full upper triangle of r. */
l = -1;
for (k = 0; k < n; ++k) {
if (fabs(r[k + k * ldr]) <= tolr) {
break;
}
r[k + k * ldr] = 1. / r[k + k * ldr];
if (k > 0) {
for (j = 0; j < k; ++j) {
// coverity[copy_paste_error]
temp = r[k + k * ldr] * r[j + k * ldr];
r[j + k * ldr] = 0.;
for (i = 0; i <= j; ++i) {
r[i + k * ldr] -= temp * r[i + j * ldr];
}
}
}
l = k;
}
/* form the full upper triangle of the inverse of (r transpose)*r */
/* in the full upper triangle of r. */
if (l >= 0) {
for (k = 0; k <= l; ++k) {
if (k > 0) {
for (j = 0; j < k; ++j) {
temp = r[j + k * ldr];
for (i = 0; i <= j; ++i) {
r[i + j * ldr] += temp * r[i + k * ldr];
}
}
}
temp = r[k + k * ldr];
for (i = 0; i <= k; ++i) {
r[i + k * ldr] *= temp;
}
}
}
/* form the full lower triangle of the covariance matrix */
/* in the strict lower triangle of r and in wa. */
for (j = 0; j < n; ++j) {
jj = ipvt[j]-1;
sing = j > l;
for (i = 0; i <= j; ++i) {
if (sing) {
r[i + j * ldr] = 0.;
}
ii = ipvt[i]-1;
if (ii > jj) {
r[ii + jj * ldr] = r[i + j * ldr];
}
else if (ii < jj) {
r[jj + ii * ldr] = r[i + j * ldr];
}
}
wa[jj] = r[j + j * ldr];
}
/* symmetrize the covariance matrix in r. */
for (j = 0; j < n; ++j) {
for (i = 0; i < j; ++i) {
r[i + j * ldr] = r[j + i * ldr];
}
r[j + j * ldr] = wa[j];
}
/* last card of subroutine covar. */
} /* covar_ */

View File

@ -1,166 +0,0 @@
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
/* covar1 estimates the variance-covariance matrix:
C = sigma**2 (JtJ)**+
where (JtJ)**+ is the inverse of JtJ or the pseudo-inverse of JtJ (in case J does not have full rank),
and sigma**2 = fsumsq / (m - k)
where fsumsq is the residual sum of squares and k is the rank of J.
*/
__cminpack_attr__
int __cminpack_func__(covar1)(int m, int n, real fsumsq, real *r, int ldr,
const int *ipvt, real tol, real *wa)
{
/* Local variables */
int i, j, k, l, ii, jj;
int sing;
real temp, tolr;
/* ********** */
/* subroutine covar */
/* given an m by n matrix a, the problem is to determine */
/* the covariance matrix corresponding to a, defined as */
/* t */
/* inverse(a *a) . */
/* 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 covar expects */
/* the full upper triangle of r and the permutation matrix p. */
/* the covariance matrix is then computed as */
/* t t */
/* p*inverse(r *r)*p . */
/* if a is nearly rank deficient, it may be desirable to compute */
/* the covariance matrix corresponding to the linearly independent */
/* columns of a. to define the numerical rank of a, covar uses */
/* the tolerance tol. if l is the largest integer such that */
/* abs(r(l,l)) .gt. tol*abs(r(1,1)) , */
/* then covar computes the covariance matrix corresponding to */
/* the first l columns of r. for k greater than l, column */
/* and row ipvt(k) of the covariance matrix are set to zero. */
/* the subroutine statement is */
/* subroutine covar(n,r,ldr,ipvt,tol,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 */
/* r contains the square symmetric covariance matrix. */
/* 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. */
/* tol is a nonnegative input variable used to define the */
/* numerical rank of a in the manner described above. */
/* wa is a work array of length n. */
/* subprograms called */
/* fortran-supplied ... dabs */
/* argonne national laboratory. minpack project. august 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
tolr = tol * fabs(r[0]);
/* form the inverse of r in the full upper triangle of r. */
l = -1;
for (k = 0; k < n; ++k) {
if (fabs(r[k + k * ldr]) <= tolr) {
break;
}
r[k + k * ldr] = 1. / r[k + k * ldr];
if (k > 0) {
for (j = 0; j < k; ++j) {
// coverity[copy_paste_error]
temp = r[k + k * ldr] * r[j + k * ldr];
r[j + k * ldr] = 0.;
for (i = 0; i <= j; ++i) {
r[i + k * ldr] -= temp * r[i + j * ldr];
}
}
}
l = k;
}
/* form the full upper triangle of the inverse of (r transpose)*r */
/* in the full upper triangle of r. */
if (l >= 0) {
for (k = 0; k <= l; ++k) {
if (k > 0) {
for (j = 0; j < k; ++j) {
temp = r[j + k * ldr];
for (i = 0; i <= j; ++i) {
r[i + j * ldr] += temp * r[i + k * ldr];
}
}
}
temp = r[k + k * ldr];
for (i = 0; i <= k; ++i) {
r[i + k * ldr] *= temp;
}
}
}
/* form the full lower triangle of the covariance matrix */
/* in the strict lower triangle of r and in wa. */
for (j = 0; j < n; ++j) {
jj = ipvt[j]-1;
sing = j > l;
for (i = 0; i <= j; ++i) {
if (sing) {
r[i + j * ldr] = 0.;
}
ii = ipvt[i]-1;
if (ii > jj) {
r[ii + jj * ldr] = r[i + j * ldr];
}
else if (ii < jj) {
r[jj + ii * ldr] = r[i + j * ldr];
}
}
wa[jj] = r[j + j * ldr];
}
/* symmetrize the covariance matrix in r. */
temp = fsumsq / (m - (l + 1));
for (j = 0; j < n; ++j) {
for (i = 0; i < j; ++i) {
r[j + i * ldr] *= temp;
r[i + j * ldr] = r[j + i * ldr];
}
r[j + j * ldr] = temp * wa[j];
}
/* last card of subroutine covar. */
if (l == (n - 1)) {
return 0;
}
return l + 1;
} /* covar_ */

View File

@ -1,210 +0,0 @@
/* covar.f -- translated by f2c (version 20100827).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(covar)(const int *n, real *r__, const int *ldr,
const int *ipvt, const real *tol, real *wa)
{
/* System generated locals */
int r_dim1, r_offset, i__1, i__2, i__3;
/* Local variables */
int i__, j, k, l, ii, jj, km1;
int sing;
real temp, tolr;
/* ********** */
/* subroutine covar */
/* given an m by n matrix a, the problem is to determine */
/* the covariance matrix corresponding to a, defined as */
/* t */
/* inverse(a *a) . */
/* 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 covar expects */
/* the full upper triangle of r and the permutation matrix p. */
/* the covariance matrix is then computed as */
/* t t */
/* p*inverse(r *r)*p . */
/* if a is nearly rank deficient, it may be desirable to compute */
/* the covariance matrix corresponding to the linearly independent */
/* columns of a. to define the numerical rank of a, covar uses */
/* the tolerance tol. if l is the largest integer such that */
/* abs(r(l,l)) .gt. tol*abs(r(1,1)) , */
/* then covar computes the covariance matrix corresponding to */
/* the first l columns of r. for k greater than l, column */
/* and row ipvt(k) of the covariance matrix are set to zero. */
/* the subroutine statement is */
/* subroutine covar(n,r,ldr,ipvt,tol,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 */
/* r contains the square symmetric covariance matrix. */
/* 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. */
/* tol is a nonnegative input variable used to define the */
/* numerical rank of a in the manner described above. */
/* wa is a work array of length n. */
/* subprograms called */
/* fortran-supplied ... dabs */
/* argonne national laboratory. minpack project. august 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa;
--ipvt;
tolr = *tol * fabs(r__[0]);
r_dim1 = *ldr;
r_offset = 1 + r_dim1;
r__ -= r_offset;
/* Function Body */
/* form the inverse of r in the full upper triangle of r. */
l = 0;
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
if (fabs(r__[k + k * r_dim1]) <= tolr) {
goto L50;
}
r__[k + k * r_dim1] = 1. / r__[k + k * r_dim1];
km1 = k - 1;
if (km1 < 1) {
goto L30;
}
i__2 = km1;
for (j = 1; j <= i__2; ++j) {
// coverity[copy_paste_error]
temp = r__[k + k * r_dim1] * r__[j + k * r_dim1];
r__[j + k * r_dim1] = 0.;
i__3 = j;
for (i__ = 1; i__ <= i__3; ++i__) {
r__[i__ + k * r_dim1] -= temp * r__[i__ + j * r_dim1];
/* L10: */
}
/* L20: */
}
L30:
l = k;
/* L40: */
}
L50:
/* form the full upper triangle of the inverse of (r transpose)*r */
/* in the full upper triangle of r. */
if (l < 1) {
goto L110;
}
i__1 = l;
for (k = 1; k <= i__1; ++k) {
km1 = k - 1;
if (km1 < 1) {
goto L80;
}
i__2 = km1;
for (j = 1; j <= i__2; ++j) {
temp = r__[j + k * r_dim1];
i__3 = j;
for (i__ = 1; i__ <= i__3; ++i__) {
r__[i__ + j * r_dim1] += temp * r__[i__ + k * r_dim1];
/* L60: */
}
/* L70: */
}
L80:
temp = r__[k + k * r_dim1];
i__2 = k;
for (i__ = 1; i__ <= i__2; ++i__) {
r__[i__ + k * r_dim1] = temp * r__[i__ + k * r_dim1];
/* L90: */
}
/* L100: */
}
L110:
/* form the full lower triangle of the covariance matrix */
/* in the strict lower triangle of r and in wa. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
jj = ipvt[j];
sing = j > l;
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
if (sing) {
r__[i__ + j * r_dim1] = 0.;
}
ii = ipvt[i__];
if (ii > jj) {
r__[ii + jj * r_dim1] = r__[i__ + j * r_dim1];
}
if (ii < jj) {
r__[jj + ii * r_dim1] = r__[i__ + j * r_dim1];
}
/* L120: */
}
wa[jj] = r__[j + j * r_dim1];
/* L130: */
}
/* symmetrize the covariance matrix in r. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
r__[i__ + j * r_dim1] = r__[j + i__ * r_dim1];
/* L140: */
}
r__[j + j * r_dim1] = wa[j];
/* L150: */
}
/*return 0;*/
/* last card of subroutine covar. */
} /* covar_ */

View File

@ -1,219 +0,0 @@
/* dogleg.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
/* Table of constant values */
__cminpack_attr__
void __cminpack_func__(dogleg)(int n, const real *r, int lr,
const real *diag, const real *qtb, real delta, real *x,
real *wa1, real *wa2)
{
/* System generated locals */
real d1, d2, d3, d4;
/* Local variables */
int i, j, k, l, jj, jp1;
real sum, temp, alpha, bnorm;
real gnorm, qnorm, epsmch;
real sgnorm;
/* ********** */
/* subroutine dogleg */
/* 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 the convex combination x of the */
/* gauss-newton and scaled gradient directions that minimizes */
/* (a*x - b) in the least squares sense, subject to the */
/* restriction that the euclidean norm of d*x be at most delta. */
/* this subroutine completes the solution of the problem */
/* if it is provided with the necessary information from the */
/* qr factorization of a. that is, if a = q*r, where q has */
/* orthogonal columns and r is an upper triangular matrix, */
/* then dogleg expects the full upper triangle of r and */
/* the first n components of (q transpose)*b. */
/* the subroutine statement is */
/* subroutine dogleg(n,r,lr,diag,qtb,delta,x,wa1,wa2) */
/* where */
/* n is a positive integer input variable set to the order of r. */
/* r is an input array of length lr which must contain the upper */
/* triangular matrix r stored by rows. */
/* lr is a positive integer input variable not less than */
/* (n*(n+1))/2. */
/* 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. */
/* x is an output array of length n which contains the desired */
/* convex combination of the gauss-newton direction and the */
/* scaled gradient direction. */
/* wa1 and wa2 are work arrays of length n. */
/* subprograms called */
/* minpack-supplied ... dpmpar,enorm */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa2;
--wa1;
--x;
--qtb;
--diag;
--r;
(void)lr;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(1);
/* first, calculate the gauss-newton direction. */
jj = n * (n + 1) / 2 + 1;
for (k = 1; k <= n; ++k) {
j = n - k + 1;
jp1 = j + 1;
jj -= k;
l = jj + 1;
sum = 0.;
if (n >= jp1) {
for (i = jp1; i <= n; ++i) {
sum += r[l] * x[i];
++l;
}
}
temp = r[jj];
if (temp == 0.) {
l = j;
for (i = 1; i <= j; ++i) {
/* Computing MAX */
d2 = fabs(r[l]);
temp = max(temp,d2);
l = l + n - i;
}
temp = epsmch * temp;
if (temp == 0.) {
temp = epsmch;
}
}
x[j] = (qtb[j] - sum) / temp;
}
/* test whether the gauss-newton direction is acceptable. */
for (j = 1; j <= n; ++j) {
wa1[j] = 0.;
wa2[j] = diag[j] * x[j];
}
qnorm = __cminpack_enorm__(n, &wa2[1]);
if (qnorm <= delta) {
return;
}
/* the gauss-newton direction is not acceptable. */
/* next, calculate the scaled gradient direction. */
l = 1;
for (j = 1; j <= n; ++j) {
temp = qtb[j];
for (i = j; i <= n; ++i) {
wa1[i] += r[l] * temp;
++l;
}
wa1[j] /= diag[j];
}
/* calculate the norm of the scaled gradient and test for */
/* the special case in which the scaled gradient is zero. */
gnorm = __cminpack_enorm__(n, &wa1[1]);
sgnorm = 0.;
alpha = delta / qnorm;
if (gnorm != 0.) {
/* calculate the point along the scaled gradient */
/* at which the quadratic is minimized. */
for (j = 1; j <= n; ++j) {
wa1[j] = wa1[j] / gnorm / diag[j];
}
l = 1;
for (j = 1; j <= n; ++j) {
sum = 0.;
for (i = j; i <= n; ++i) {
sum += r[l] * wa1[i];
++l;
}
wa2[j] = sum;
}
temp = __cminpack_enorm__(n, &wa2[1]);
sgnorm = gnorm / temp / temp;
/* test whether the scaled gradient direction is acceptable. */
alpha = 0.;
if (sgnorm < delta) {
/* the scaled gradient direction is not acceptable. */
/* finally, calculate the point along the dogleg */
/* at which the quadratic is minimized. */
bnorm = __cminpack_enorm__(n, &qtb[1]);
temp = bnorm / gnorm * (bnorm / qnorm) * (sgnorm / delta);
/* Computing 2nd power */
d1 = sgnorm / delta;
/* Computing 2nd power */
d2 = temp - delta / qnorm;
/* Computing 2nd power */
d3 = delta / qnorm;
/* Computing 2nd power */
d4 = sgnorm / delta;
temp = temp - delta / qnorm * (d1 * d1)
+ sqrt(d2 * d2
+ (1. - d3 * d3) * (1. - d4 * d4));
/* Computing 2nd power */
d1 = sgnorm / delta;
alpha = delta / qnorm * (1. - d1 * d1) / temp;
}
}
/* form appropriate convex combination of the gauss-newton */
/* direction and the scaled gradient direction. */
temp = (1. - alpha) * min(sgnorm,delta);
for (j = 1; j <= n; ++j) {
x[j] = temp * wa1[j] + alpha * x[j];
}
/* last card of subroutine dogleg. */
} /* dogleg_ */

View File

@ -1,250 +0,0 @@
/* dogleg.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
/* Table of constant values */
__minpack_attr__
void __minpack_func__(dogleg)(const int *n, const real *r__, const int *lr,
const real *diag, const real *qtb, const real *delta, real *x,
real *wa1, real *wa2)
{
/* System generated locals */
int i__1, i__2;
real d__1, d__2, d__3, d__4;
/* Local variables */
int i__, j, k, l, jj, jp1;
real sum, temp, alpha, bnorm;
real gnorm, qnorm, epsmch;
real sgnorm;
const int c__1 = 1;
/* ********** */
/* subroutine dogleg */
/* 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 the convex combination x of the */
/* gauss-newton and scaled gradient directions that minimizes */
/* (a*x - b) in the least squares sense, subject to the */
/* restriction that the euclidean norm of d*x be at most delta. */
/* this subroutine completes the solution of the problem */
/* if it is provided with the necessary information from the */
/* qr factorization of a. that is, if a = q*r, where q has */
/* orthogonal columns and r is an upper triangular matrix, */
/* then dogleg expects the full upper triangle of r and */
/* the first n components of (q transpose)*b. */
/* the subroutine statement is */
/* subroutine dogleg(n,r,lr,diag,qtb,delta,x,wa1,wa2) */
/* where */
/* n is a positive integer input variable set to the order of r. */
/* r is an input array of length lr which must contain the upper */
/* triangular matrix r stored by rows. */
/* lr is a positive integer input variable not less than */
/* (n*(n+1))/2. */
/* 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. */
/* x is an output array of length n which contains the desired */
/* convex combination of the gauss-newton direction and the */
/* scaled gradient direction. */
/* wa1 and wa2 are work arrays of length n. */
/* subprograms called */
/* minpack-supplied ... dpmpar,enorm */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa2;
--wa1;
--x;
--qtb;
--diag;
--r__;
(void)lr;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(dpmpar)(&c__1);
/* first, calculate the gauss-newton direction. */
jj = *n * (*n + 1) / 2 + 1;
i__1 = *n;
for (k = 1; k <= i__1; ++k) {
j = *n - k + 1;
jp1 = j + 1;
jj -= k;
l = jj + 1;
sum = 0.;
if (*n < jp1) {
goto L20;
}
i__2 = *n;
for (i__ = jp1; i__ <= i__2; ++i__) {
sum += r__[l] * x[i__];
++l;
/* L10: */
}
L20:
temp = r__[jj];
if (temp != 0.) {
goto L40;
}
l = j;
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
d__2 = temp, d__3 = fabs(r__[l]);
temp = max(d__2,d__3);
l = l + *n - i__;
/* L30: */
}
temp = epsmch * temp;
if (temp == 0.) {
temp = epsmch;
}
L40:
x[j] = (qtb[j] - sum) / temp;
/* L50: */
}
/* test whether the gauss-newton direction is acceptable. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] = 0.;
wa2[j] = diag[j] * x[j];
/* L60: */
}
qnorm = __minpack_func__(enorm)(n, &wa2[1]);
if (qnorm <= *delta) {
/* goto L140; */
return;
}
/* the gauss-newton direction is not acceptable. */
/* next, calculate the scaled gradient direction. */
l = 1;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
temp = qtb[j];
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
wa1[i__] += r__[l] * temp;
++l;
/* L70: */
}
wa1[j] /= diag[j];
/* L80: */
}
/* calculate the norm of the scaled gradient and test for */
/* the special case in which the scaled gradient is zero. */
gnorm = __minpack_func__(enorm)(n, &wa1[1]);
sgnorm = 0.;
alpha = *delta / qnorm;
if (gnorm == 0.) {
goto L120;
}
/* calculate the point along the scaled gradient */
/* at which the quadratic is minimized. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] = wa1[j] / gnorm / diag[j];
/* L90: */
}
l = 1;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
sum = 0.;
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
sum += r__[l] * wa1[i__];
++l;
/* L100: */
}
wa2[j] = sum;
/* L110: */
}
temp = __minpack_func__(enorm)(n, &wa2[1]);
sgnorm = gnorm / temp / temp;
/* test whether the scaled gradient direction is acceptable. */
alpha = 0.;
if (sgnorm >= *delta) {
goto L120;
}
/* the scaled gradient direction is not acceptable. */
/* finally, calculate the point along the dogleg */
/* at which the quadratic is minimized. */
bnorm = __minpack_func__(enorm)(n, &qtb[1]);
temp = bnorm / gnorm * (bnorm / qnorm) * (sgnorm / *delta);
/* Computing 2nd power */
d__1 = sgnorm / *delta;
/* Computing 2nd power */
d__2 = temp - *delta / qnorm;
/* Computing 2nd power */
d__3 = *delta / qnorm;
/* Computing 2nd power */
d__4 = sgnorm / *delta;
temp = temp - *delta / qnorm * (d__1 * d__1) + sqrt(d__2 * d__2 + (1. -
d__3 * d__3) * (1. - d__4 * d__4));
/* Computing 2nd power */
d__1 = sgnorm / *delta;
alpha = *delta / qnorm * (1. - d__1 * d__1) / temp;
L120:
/* form appropriate convex combination of the gauss-newton */
/* direction and the scaled gradient direction. */
temp = (1. - alpha) * min(sgnorm,*delta);
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
x[j] = temp * wa1[j] + alpha * x[j];
/* L130: */
}
/* L140: */
return;
/* last card of subroutine dogleg. */
} /* dogleg_ */

View File

@ -1,191 +0,0 @@
#include "cminpack.h"
#include <float.h>
#include "cminpackP.h"
#define DPMPAR(type,X) _DPMPAR(type,X)
#define _DPMPAR(type,X) type ## _ ## X
__cminpack_attr__
real __cminpack_func__(dpmpar)(int 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. November 1996. */
/* Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More' */
/* ********** */
/* Machine constants for the IBM 360/370 series, */
/* the Amdahl 470/V6, the ICL 2900, the Itel AS/6, */
/* the Xerox Sigma 5/7/9 and the Sel systems 85/86. */
/* data mcheps(1),mcheps(2) / z34100000, z00000000 / */
/* data minmag(1),minmag(2) / z00100000, z00000000 / */
/* data maxmag(1),maxmag(2) / z7fffffff, zffffffff / */
/* Machine constants for the Honeywell 600/6000 series. */
/* data mcheps(1),mcheps(2) / o606400000000, o000000000000 / */
/* data minmag(1),minmag(2) / o402400000000, o000000000000 / */
/* data maxmag(1),maxmag(2) / o376777777777, o777777777777 / */
/* Machine constants for the CDC 6000/7000 series. */
/* data mcheps(1) / 15614000000000000000b / */
/* data mcheps(2) / 15010000000000000000b / */
/* data minmag(1) / 00604000000000000000b / */
/* data minmag(2) / 00000000000000000000b / */
/* data maxmag(1) / 37767777777777777777b / */
/* data maxmag(2) / 37167777777777777777b / */
/* Machine constants for the PDP-10 (KA processor). */
/* data mcheps(1),mcheps(2) / "114400000000, "000000000000 / */
/* data minmag(1),minmag(2) / "033400000000, "000000000000 / */
/* data maxmag(1),maxmag(2) / "377777777777, "344777777777 / */
/* Machine constants for the PDP-10 (KI processor). */
/* data mcheps(1),mcheps(2) / "104400000000, "000000000000 / */
/* data minmag(1),minmag(2) / "000400000000, "000000000000 / */
/* data maxmag(1),maxmag(2) / "377777777777, "377777777777 / */
/* Machine constants for the PDP-11. */
/* data mcheps(1),mcheps(2) / 9472, 0 / */
/* data mcheps(3),mcheps(4) / 0, 0 / */
/* data minmag(1),minmag(2) / 128, 0 / */
/* data minmag(3),minmag(4) / 0, 0 / */
/* data maxmag(1),maxmag(2) / 32767, -1 / */
/* data maxmag(3),maxmag(4) / -1, -1 / */
/* Machine constants for the Burroughs 6700/7700 systems. */
/* data mcheps(1) / o1451000000000000 / */
/* data mcheps(2) / o0000000000000000 / */
/* data minmag(1) / o1771000000000000 / */
/* data minmag(2) / o7770000000000000 / */
/* data maxmag(1) / o0777777777777777 / */
/* data maxmag(2) / o7777777777777777 / */
/* Machine constants for the Burroughs 5700 system. */
/* data mcheps(1) / o1451000000000000 / */
/* data mcheps(2) / o0000000000000000 / */
/* data minmag(1) / o1771000000000000 / */
/* data minmag(2) / o0000000000000000 / */
/* data maxmag(1) / o0777777777777777 / */
/* data maxmag(2) / o0007777777777777 / */
/* Machine constants for the Burroughs 1700 system. */
/* data mcheps(1) / zcc6800000 / */
/* data mcheps(2) / z000000000 / */
/* data minmag(1) / zc00800000 / */
/* data minmag(2) / z000000000 / */
/* data maxmag(1) / zdffffffff / */
/* data maxmag(2) / zfffffffff / */
/* Machine constants for the Univac 1100 series. */
/* data mcheps(1),mcheps(2) / o170640000000, o000000000000 / */
/* data minmag(1),minmag(2) / o000040000000, o000000000000 / */
/* data maxmag(1),maxmag(2) / o377777777777, o777777777777 / */
/* Machine constants for the Data General Eclipse S/200. */
/* Note - it may be appropriate to include the following card - */
/* static dmach(3) */
/* data minmag/20k,3*0/,maxmag/77777k,3*177777k/ */
/* data mcheps/32020k,3*0/ */
/* Machine constants for the Harris 220. */
/* data mcheps(1),mcheps(2) / '20000000, '00000334 / */
/* data minmag(1),minmag(2) / '20000000, '00000201 / */
/* data maxmag(1),maxmag(2) / '37777777, '37777577 / */
/* Machine constants for the Cray-1. */
/* data mcheps(1) / 0376424000000000000000b / */
/* data mcheps(2) / 0000000000000000000000b / */
/* data minmag(1) / 0200034000000000000000b / */
/* data minmag(2) / 0000000000000000000000b / */
/* data maxmag(1) / 0577777777777777777777b / */
/* data maxmag(2) / 0000007777777777777776b / */
/* Machine constants for the Prime 400. */
/* data mcheps(1),mcheps(2) / :10000000000, :00000000123 / */
/* data minmag(1),minmag(2) / :10000000000, :00000100000 / */
/* data maxmag(1),maxmag(2) / :17777777777, :37777677776 / */
/* Machine constants for the VAX-11. */
/* data mcheps(1),mcheps(2) / 9472, 0 / */
/* data minmag(1),minmag(2) / 128, 0 / */
/* data maxmag(1),maxmag(2) / -32769, -1 / */
/* Machine constants for IEEE machines. */
/* data dmach(1) /2.22044604926d-16/ */
/* data dmach(2) /2.22507385852d-308/ */
/* data dmach(3) /1.79769313485d+308/ */
switch(i) {
case 1:
return DPMPAR(realm,EPSILON); /* 2.2204460492503131e-16 | 1.19209290e-07F */
case 2:
return DPMPAR(realm,MIN); /* 2.2250738585072014e-308 | 1.17549435e-38F */
default:
return DPMPAR(realm,MAX); /* 1.7976931348623157e+308 | 3.40282347e+38F */
}
/* Last card of function dpmpar. */
} /* dpmpar_ */
#undef mcheps
#undef maxmag
#undef minmag
#undef dmach

View File

@ -1,196 +0,0 @@
/* dpmpar.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include "minpackP.h"
#define DPMPAR(type,X) _DPMPAR(type,X)
#define _DPMPAR(type,X) type ## _ ## X
__minpack_attr__
real __minpack_func__(dpmpar)(const int *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. November 1996. */
/* Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More' */
/* ********** */
/* Machine constants for the IBM 360/370 series, */
/* the Amdahl 470/V6, the ICL 2900, the Itel AS/6, */
/* the Xerox Sigma 5/7/9 and the Sel systems 85/86. */
/* data mcheps(1),mcheps(2) / z34100000, z00000000 / */
/* data minmag(1),minmag(2) / z00100000, z00000000 / */
/* data maxmag(1),maxmag(2) / z7fffffff, zffffffff / */
/* Machine constants for the Honeywell 600/6000 series. */
/* data mcheps(1),mcheps(2) / o606400000000, o000000000000 / */
/* data minmag(1),minmag(2) / o402400000000, o000000000000 / */
/* data maxmag(1),maxmag(2) / o376777777777, o777777777777 / */
/* Machine constants for the CDC 6000/7000 series. */
/* data mcheps(1) / 15614000000000000000b / */
/* data mcheps(2) / 15010000000000000000b / */
/* data minmag(1) / 00604000000000000000b / */
/* data minmag(2) / 00000000000000000000b / */
/* data maxmag(1) / 37767777777777777777b / */
/* data maxmag(2) / 37167777777777777777b / */
/* Machine constants for the PDP-10 (KA processor). */
/* data mcheps(1),mcheps(2) / "114400000000, "000000000000 / */
/* data minmag(1),minmag(2) / "033400000000, "000000000000 / */
/* data maxmag(1),maxmag(2) / "377777777777, "344777777777 / */
/* Machine constants for the PDP-10 (KI processor). */
/* data mcheps(1),mcheps(2) / "104400000000, "000000000000 / */
/* data minmag(1),minmag(2) / "000400000000, "000000000000 / */
/* data maxmag(1),maxmag(2) / "377777777777, "377777777777 / */
/* Machine constants for the PDP-11. */
/* data mcheps(1),mcheps(2) / 9472, 0 / */
/* data mcheps(3),mcheps(4) / 0, 0 / */
/* data minmag(1),minmag(2) / 128, 0 / */
/* data minmag(3),minmag(4) / 0, 0 / */
/* data maxmag(1),maxmag(2) / 32767, -1 / */
/* data maxmag(3),maxmag(4) / -1, -1 / */
/* Machine constants for the Burroughs 6700/7700 systems. */
/* data mcheps(1) / o1451000000000000 / */
/* data mcheps(2) / o0000000000000000 / */
/* data minmag(1) / o1771000000000000 / */
/* data minmag(2) / o7770000000000000 / */
/* data maxmag(1) / o0777777777777777 / */
/* data maxmag(2) / o7777777777777777 / */
/* Machine constants for the Burroughs 5700 system. */
/* data mcheps(1) / o1451000000000000 / */
/* data mcheps(2) / o0000000000000000 / */
/* data minmag(1) / o1771000000000000 / */
/* data minmag(2) / o0000000000000000 / */
/* data maxmag(1) / o0777777777777777 / */
/* data maxmag(2) / o0007777777777777 / */
/* Machine constants for the Burroughs 1700 system. */
/* data mcheps(1) / zcc6800000 / */
/* data mcheps(2) / z000000000 / */
/* data minmag(1) / zc00800000 / */
/* data minmag(2) / z000000000 / */
/* data maxmag(1) / zdffffffff / */
/* data maxmag(2) / zfffffffff / */
/* Machine constants for the Univac 1100 series. */
/* data mcheps(1),mcheps(2) / o170640000000, o000000000000 / */
/* data minmag(1),minmag(2) / o000040000000, o000000000000 / */
/* data maxmag(1),maxmag(2) / o377777777777, o777777777777 / */
/* Machine constants for the Data General Eclipse S/200. */
/* Note - it may be appropriate to include the following card - */
/* static dmach(3) */
/* data minmag/20k,3*0/,maxmag/77777k,3*177777k/ */
/* data mcheps/32020k,3*0/ */
/* Machine constants for the Harris 220. */
/* data mcheps(1),mcheps(2) / '20000000, '00000334 / */
/* data minmag(1),minmag(2) / '20000000, '00000201 / */
/* data maxmag(1),maxmag(2) / '37777777, '37777577 / */
/* Machine constants for the Cray-1. */
/* data mcheps(1) / 0376424000000000000000b / */
/* data mcheps(2) / 0000000000000000000000b / */
/* data minmag(1) / 0200034000000000000000b / */
/* data minmag(2) / 0000000000000000000000b / */
/* data maxmag(1) / 0577777777777777777777b / */
/* data maxmag(2) / 0000007777777777777776b / */
/* Machine constants for the Prime 400. */
/* data mcheps(1),mcheps(2) / :10000000000, :00000000123 / */
/* data minmag(1),minmag(2) / :10000000000, :00000100000 / */
/* data maxmag(1),maxmag(2) / :17777777777, :37777677776 / */
/* Machine constants for the VAX-11. */
/* data mcheps(1),mcheps(2) / 9472, 0 / */
/* data minmag(1),minmag(2) / 128, 0 / */
/* data maxmag(1),maxmag(2) / -32769, -1 / */
/* Machine constants for IEEE machines. */
/* data dmach(1) /2.22044604926d-16/ */
/* data dmach(2) /2.22507385852d-308/ */
/* data dmach(3) /1.79769313485d+308/ */
switch(*i) {
case 1:
return DPMPAR(realm,EPSILON); /* 2.2204460492503131e-16 | 1.19209290e-07F */
case 2:
return DPMPAR(realm,MIN); /* 2.2250738585072014e-308 | 1.17549435e-38F */
default:
return DPMPAR(realm,MAX); /* 1.7976931348623157e+308 | 3.40282347e+38F */
}
/* Last card of function dpmpar. */
} /* dpmpar_ */
#undef mcheps
#undef maxmag
#undef minmag
#undef dmach

View File

@ -1,157 +0,0 @@
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
/*
About the values for rdwarf and rgiant.
The original values, both in single-precision FORTRAN source code and in double-precision code were:
#define rdwarf 3.834e-20
#define rgiant 1.304e19
See for example:
http://www.netlib.org/slatec/src/denorm.f
http://www.netlib.org/slatec/src/enorm.f
However, rdwarf is smaller than sqrt(FLT_MIN) = 1.0842021724855044e-19, so that rdwarf**2 will
underflow. This contradicts the constraints expressed in the comments below.
We changed these constants to those proposed by the
implementation found in MPFIT http://cow.physics.wisc.edu/~craigm/idl/fitting.html
cmpfit-1.2 proposes the following definitions:
rdwarf = sqrt(dpmpar(2)*1.5) * 10
rgiant = sqrt(dpmpar(3)) * 0.1
The half version does not really worked that way, so we use for half:
rdwarf = sqrt(dpmpar(2)) * 2
rgiant = sqrt(dpmpar(3)) * 0.5
Any suggestion is welcome. Half CMINPACK is really only a
proof-of-concept anyway.
See the example/tenorm*c, which computes these values
*/
#define double_dwarf (1.82691291192569e-153)
#define double_giant (1.34078079299426e+153)
#define long_double_dwarf (2.245696932951581572e-2465l)
#define long_double_giant (1.090748135619415929e+2465l)
#define float_dwarf (1.327871072777421e-18f)
#define float_giant (1.844674297419792e+18f)
#define half_dwarf (0.015625f)
#define half_giant (127.9375f)
#define dwarf(type) _dwarf(type)
#define _dwarf(type) type ## _dwarf
#define giant(type) _giant(type)
#define _giant(type) type ## _giant
#define rdwarf dwarf(realm)
#define rgiant giant(realm)
__cminpack_attr__
real __cminpack_func__(enorm)(int n, const real *x)
{
#ifdef USE_CBLAS
return cblas_dnrm2(n, x, 1);
#else /* !USE_CBLAS */
/* System generated locals */
real ret_val, d1;
/* Local variables */
int i;
real s1, s2, s3, xabs, x1max, x3max, 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. */
/* subprograms called */
/* fortran-supplied ... dabs,dsqrt */
/* 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 / (real)n;
for (i = 0; i < n; ++i) {
xabs = fabs(x[i]);
if (xabs >= agiant) {
/* sum for large components. */
if (xabs > x1max) {
/* Computing 2nd power */
d1 = x1max / xabs;
s1 = 1. + s1 * (d1 * d1);
x1max = xabs;
} else {
/* Computing 2nd power */
d1 = xabs / x1max;
s1 += d1 * d1;
}
} else if (xabs <= rdwarf) {
/* sum for small components. */
if (xabs > x3max) {
/* Computing 2nd power */
d1 = x3max / xabs;
s3 = 1. + s3 * (d1 * d1);
x3max = xabs;
} else if (xabs != 0.) {
/* Computing 2nd power */
d1 = xabs / x3max;
s3 += d1 * d1;
}
} else {
/* sum for intermediate components. */
/* Computing 2nd power */
s2 += xabs * xabs;
}
}
/* calculation of norm. */
if (s1 != 0.) {
ret_val = x1max * sqrt(s1 + (s2 / x1max) / x1max);
} else if (s2 != 0.) {
if (s2 >= x3max) {
ret_val = sqrt(s2 * (1. + (x3max / s2) * (x3max * s3)));
} else {
ret_val = sqrt(x3max * ((s2 / x3max) + (x3max * s3)));
}
} else {
ret_val = x3max * sqrt(s3);
}
return ret_val;
/* last card of function enorm. */
#endif /* !USE_CBLAS */
} /* enorm_ */

View File

@ -1,199 +0,0 @@
/* enorm.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
/*
About the values for rdwarf and rgiant.
The original values, both in single-precision FORTRAN source code and in double-precision code were:
#define rdwarf 3.834e-20
#define rgiant 1.304e19
See for example:
http://www.netlib.org/slatec/src/denorm.f
http://www.netlib.org/slatec/src/enorm.f
However, rdwarf is smaller than sqrt(FLT_MIN) = 1.0842021724855044e-19, so that rdwarf**2 will
underflow. This contradicts the constraints expressed in the comments below.
We changed these constants to those proposed by the
implementation found in MPFIT http://cow.physics.wisc.edu/~craigm/idl/fitting.html
cmpfit-1.2 proposes the following definitions:
rdwarf = sqrt(dpmpar(2)*1.5) * 10
rgiant = sqrt(dpmpar(3)) * 0.1
The half version does not really worked that way, so we use for half:
rdwarf = sqrt(dpmpar(2)) * 2
rgiant = sqrt(dpmpar(3)) * 0.5
Any suggestion is welcome. Half CMINPACK is really only a
proof-of-concept anyway.
See the example/tenorm*c, which computes these values
*/
#define double_dwarf (1.82691291192569e-153)
#define double_giant (1.34078079299426e+153)
#define long_double_dwarf (2.245696932951581572e-2465l)
#define long_double_giant (1.090748135619415929e+2465l)
#define float_dwarf (1.327871072777421e-18f)
#define float_giant (1.844674297419792e+18f)
#define half_dwarf (0.015625f)
#define half_giant (127.9375f)
#define dwarf(type) _dwarf(type)
#define _dwarf(type) type ## _dwarf
#define giant(type) _giant(type)
#define _giant(type) type ## _giant
#define rdwarf dwarf(realm)
#define rgiant giant(realm)
__minpack_attr__
real __minpack_func__(enorm)(const int *n, const real *x)
{
/* System generated locals */
int i__1;
real ret_val, d__1;
/* Local variables */
int i__;
real s1, s2, s3, xabs, x1max, x3max, agiant, floatn;
/* ********** */
/* 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. */
/* subprograms called */
/* fortran-supplied ... dabs,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--x;
/* Function Body */
s1 = 0.;
s2 = 0.;
s3 = 0.;
x1max = 0.;
x3max = 0.;
floatn = (real) (*n);
agiant = rgiant / floatn;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
xabs = fabs(x[i__]);
if (xabs > rdwarf && xabs < agiant) {
goto L70;
}
if (xabs <= rdwarf) {
goto L30;
}
/* sum for large components. */
if (xabs <= x1max) {
goto L10;
}
/* Computing 2nd power */
d__1 = x1max / xabs;
s1 = 1. + s1 * (d__1 * d__1);
x1max = xabs;
goto L20;
L10:
/* Computing 2nd power */
d__1 = xabs / x1max;
s1 += d__1 * d__1;
L20:
goto L60;
L30:
/* sum for small components. */
if (xabs <= x3max) {
goto L40;
}
/* Computing 2nd power */
d__1 = x3max / xabs;
s3 = 1. + s3 * (d__1 * d__1);
x3max = xabs;
goto L50;
L40:
if (xabs != 0.) {
/* Computing 2nd power */
d__1 = xabs / x3max;
s3 += d__1 * d__1;
}
L50:
L60:
goto L80;
L70:
/* sum for intermediate components. */
/* Computing 2nd power */
d__1 = xabs;
s2 += d__1 * d__1;
L80:
/* L90: */
;
}
/* calculation of norm. */
if (s1 == 0.) {
goto L100;
}
ret_val = x1max * sqrt(s1 + s2 / x1max / x1max);
goto L130;
L100:
if (s2 == 0.) {
goto L110;
}
if (s2 >= x3max) {
ret_val = sqrt(s2 * (1. + x3max / s2 * (x3max * s3)));
} else {
ret_val = sqrt(x3max * (s2 / x3max + x3max * s3));
}
goto L120;
L110:
ret_val = x3max * sqrt(s3);
L120:
L130:
return ret_val;
/* last card of function enorm. */
} /* enorm_ */

View File

@ -1,189 +0,0 @@
/* fdjac1.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(fdjac1)(__cminpack_decl_fcn_nn__ void *p, int n, real *x, const real *
fvec, real *fjac, int ldfjac, int ml,
int mu, real epsfcn, real *wa1, real *wa2)
{
/* System generated locals */
int fjac_dim1, fjac_offset;
/* Local variables */
real h;
int i, j, k;
real eps, temp;
int msum;
real epsmch;
int iflag = 0;
/* ********** */
/* subroutine fdjac1 */
/* this subroutine computes a forward-difference approximation */
/* to the n by n jacobian matrix associated with a specified */
/* problem of n functions in n variables. if the jacobian has */
/* a banded form, then function evaluations are saved by only */
/* approximating the nonzero terms. */
/* the subroutine statement is */
/* subroutine fdjac1(fcn,n,x,fvec,fjac,ldfjac,iflag,ml,mu,epsfcn, */
/* wa1,wa2) */
/* 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(n,x,fvec,iflag) */
/* integer n,iflag */
/* double precision x(n),fvec(n) */
/* ---------- */
/* 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 fdjac1. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* x is an input array of length n. */
/* fvec is an input array of length n which must contain the */
/* functions evaluated at x. */
/* fjac is an output n by n array which contains the */
/* approximation to the jacobian matrix evaluated at x. */
/* ldfjac is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array fjac. */
/* iflag is an integer variable which can be used to terminate */
/* the execution of fdjac1. see description of fcn. */
/* ml is a nonnegative integer input variable which specifies */
/* the number of subdiagonals within the band of the */
/* jacobian matrix. if the jacobian is not banded, set */
/* ml to at least n - 1. */
/* 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. */
/* mu is a nonnegative integer input variable which specifies */
/* the number of superdiagonals within the band of the */
/* jacobian matrix. if the jacobian is not banded, set */
/* mu to at least n - 1. */
/* wa1 and wa2 are work arrays of length n. if ml + mu + 1 is at */
/* least n, then the jacobian is considered dense, and wa2 is */
/* not referenced. */
/* subprograms called */
/* minpack-supplied ... dpmpar */
/* fortran-supplied ... dabs,dmax1,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa2;
--wa1;
--fvec;
--x;
fjac_dim1 = ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(1);
eps = sqrt((max(epsfcn,epsmch)));
msum = ml + mu + 1;
if (msum >= n) {
/* computation of dense approximate jacobian. */
for (j = 1; j <= n; ++j) {
temp = x[j];
h = eps * fabs(temp);
if (h == 0.) {
h = eps;
}
x[j] = temp + h;
/* the last parameter of fcn_nn() is set to 2 to differentiate
calls made to compute the function from calls made to compute
the Jacobian (see fcn() in examples/hybdrv.c, and how njev
is used to compute the number of Jacobian evaluations) */
iflag = fcn_nn(p, n, &x[1], &wa1[1], 2);
if (iflag < 0) {
return iflag;
}
x[j] = temp;
for (i = 1; i <= n; ++i) {
fjac[i + j * fjac_dim1] = (wa1[i] - fvec[i]) / h;
}
}
return 0;
}
/* computation of banded approximate jacobian. */
for (k = 1; k <= msum; ++k) {
for (j = k; j <= n; j += msum) {
wa2[j] = x[j];
h = eps * fabs(wa2[j]);
if (h == 0.) {
h = eps;
}
x[j] = wa2[j] + h;
}
iflag = fcn_nn(p, n, &x[1], &wa1[1], 1);
if (iflag < 0) {
return iflag;
}
for (j = k; j <= n; j += msum) {
x[j] = wa2[j];
h = eps * fabs(wa2[j]);
if (h == 0.) {
h = eps;
}
for (i = 1; i <= n; ++i) {
fjac[i + j * fjac_dim1] = 0.;
if (i >= j - mu && i <= j + ml) {
fjac[i + j * fjac_dim1] = (wa1[i] - fvec[i]) / h;
}
}
}
}
return 0;
/* last card of subroutine fdjac1. */
} /* fdjac1_ */

View File

@ -1,209 +0,0 @@
/* fdjac1.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(fdjac1)(__minpack_decl_fcn_nn__ const int *n, real *x, const real *
fvec, real *fjac, const int *ldfjac, int *iflag, const int *ml,
const int *mu, const real *epsfcn, real *wa1, real *wa2)
{
/* Table of constant values */
const int c__1 = 1;
/* System generated locals */
int fjac_dim1, fjac_offset, i__1, i__2, i__3, i__4;
/* Local variables */
real h__;
int i__, j, k;
real eps, temp;
int msum;
real epsmch;
/* ********** */
/* subroutine fdjac1 */
/* this subroutine computes a forward-difference approximation */
/* to the n by n jacobian matrix associated with a specified */
/* problem of n functions in n variables. if the jacobian has */
/* a banded form, then function evaluations are saved by only */
/* approximating the nonzero terms. */
/* the subroutine statement is */
/* subroutine fdjac1(fcn,n,x,fvec,fjac,ldfjac,iflag,ml,mu,epsfcn, */
/* wa1,wa2) */
/* 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(n,x,fvec,iflag) */
/* integer n,iflag */
/* double precision x(n),fvec(n) */
/* ---------- */
/* 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 fdjac1. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* x is an input array of length n. */
/* fvec is an input array of length n which must contain the */
/* functions evaluated at x. */
/* fjac is an output n by n array which contains the */
/* approximation to the jacobian matrix evaluated at x. */
/* ldfjac is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array fjac. */
/* iflag is an integer variable which can be used to terminate */
/* the execution of fdjac1. see description of fcn. */
/* ml is a nonnegative integer input variable which specifies */
/* the number of subdiagonals within the band of the */
/* jacobian matrix. if the jacobian is not banded, set */
/* ml to at least n - 1. */
/* 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. */
/* mu is a nonnegative integer input variable which specifies */
/* the number of superdiagonals within the band of the */
/* jacobian matrix. if the jacobian is not banded, set */
/* mu to at least n - 1. */
/* wa1 and wa2 are work arrays of length n. if ml + mu + 1 is at */
/* least n, then the jacobian is considered dense, and wa2 is */
/* not referenced. */
/* subprograms called */
/* minpack-supplied ... dpmpar */
/* fortran-supplied ... dabs,dmax1,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa2;
--wa1;
--fvec;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(dpmpar)(&c__1);
eps = sqrt((max(*epsfcn,epsmch)));
msum = *ml + *mu + 1;
if (msum < *n) {
goto L40;
}
/* computation of dense approximate jacobian. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
temp = x[j];
h__ = eps * fabs(temp);
if (h__ == 0.) {
h__ = eps;
}
x[j] = temp + h__;
fcn_nn(n, &x[1], &wa1[1], iflag);
if (*iflag < 0) {
goto L30;
}
x[j] = temp;
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
fjac[i__ + j * fjac_dim1] = (wa1[i__] - fvec[i__]) / h__;
/* L10: */
}
/* L20: */
}
L30:
/* goto L110; */
return;
L40:
/* computation of banded approximate jacobian. */
i__1 = msum;
for (k = 1; k <= i__1; ++k) {
i__2 = *n;
i__3 = msum;
for (j = k; j <= i__2; j += i__3) {
wa2[j] = x[j];
h__ = eps * fabs(wa2[j]);
if (h__ == 0.) {
h__ = eps;
}
x[j] = wa2[j] + h__;
/* L60: */
}
fcn_nn(n, &x[1], &wa1[1], iflag);
if (*iflag < 0) {
/* goto L100; */
return;
}
i__3 = *n;
i__2 = msum;
for (j = k; j <= i__3; j += i__2) {
x[j] = wa2[j];
h__ = eps * fabs(wa2[j]);
if (h__ == 0.) {
h__ = eps;
}
i__4 = *n;
for (i__ = 1; i__ <= i__4; ++i__) {
fjac[i__ + j * fjac_dim1] = 0.;
if (i__ >= j - *mu && i__ <= j + *ml) {
fjac[i__ + j * fjac_dim1] = (wa1[i__] - fvec[i__]) / h__;
}
/* L70: */
}
/* L80: */
}
/* L90: */
}
/* L100: */
/* L110: */
return;
/* last card of subroutine fdjac1. */
} /* fdjac1_ */

View File

@ -1,122 +0,0 @@
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(fdjac2)(__cminpack_decl_fcn_mn__ void *p, int m, int n, real *x,
const real *fvec, real *fjac, int ldfjac,
real epsfcn, real *wa)
{
/* Local variables */
real h;
int i, j;
real eps, temp, epsmch;
int iflag;
/* ********** */
/* 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. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dpmpar */
/* fortran-supplied ... dabs,dmax1,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(1);
eps = sqrt((max(epsfcn,epsmch)));
for (j = 0; j < n; ++j) {
temp = x[j];
h = eps * fabs(temp);
if (h == 0.) {
h = eps;
}
x[j] = temp + h;
/* the last parameter of fcn_mn() is set to 2 to differentiate
calls made to compute the function from calls made to compute
the Jacobian (see fcn() in examples/lmfdrv.c, and how njev
is used to compute the number of Jacobian evaluations) */
iflag = fcn_mn(p, m, n, x, wa, 2);
if (iflag < 0) {
return iflag;
}
x[j] = temp;
for (i = 0; i < m; ++i) {
fjac[i + j * ldfjac] = (wa[i] - fvec[i]) / h;
}
}
return 0;
/* last card of subroutine fdjac2. */
} /* fdjac2_ */

View File

@ -1,144 +0,0 @@
/* fdjac2.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(fdjac2)(__minpack_decl_fcn_mn__ const int *m, const int *n, real *x,
const real *fvec, real *fjac, const int *ldfjac, int *iflag,
const real *epsfcn, real *wa)
{
/* Table of constant values */
const int c__1 = 1;
/* System generated locals */
int fjac_dim1, fjac_offset, i__1, i__2;
/* Local variables */
real h__;
int i__, j;
real eps, temp, epsmch;
/* ********** */
/* 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. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dpmpar */
/* fortran-supplied ... dabs,dmax1,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa;
--fvec;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(dpmpar)(&c__1);
eps = sqrt((max(*epsfcn,epsmch)));
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
temp = x[j];
h__ = eps * fabs(temp);
if (h__ == 0.) {
h__ = eps;
}
x[j] = temp + h__;
fcn_mn(m, n, &x[1], &wa[1], iflag);
if (*iflag < 0) {
/* goto L30; */
return;
}
x[j] = temp;
i__2 = *m;
for (i__ = 1; i__ <= i__2; ++i__) {
fjac[i__ + j * fjac_dim1] = (wa[i__] - fvec[i__]) / h__;
/* L10: */
}
/* L20: */
}
/* L30: */
return;
/* last card of subroutine fdjac2. */
} /* fdjac2_ */

View File

@ -1,570 +0,0 @@
/* hybrd.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(hybrd)(__cminpack_decl_fcn_nn__ void *p, int n, real *x, real *
fvec, real xtol, int maxfev, int ml, int mu,
real epsfcn, real *diag, int mode, real
factor, int nprint, int *nfev, real *
fjac, int ldfjac, real *r, int lr, real *qtf,
real *wa1, real *wa2, real *wa3, real *wa4)
{
/* Initialized data */
#define p1 .1
#define p5 .5
#define p001 .001
#define p0001 1e-4
/* System generated locals */
int fjac_dim1, fjac_offset, i1;
real d1, d2;
/* Local variables */
int i, j, l, jm1, iwa[1];
real sum;
int sing;
int iter;
real temp;
int msum, iflag;
real delta = 0.;
int jeval;
int ncsuc;
real ratio;
real fnorm;
real pnorm, xnorm = 0., fnorm1;
int nslow1, nslow2;
int ncfail;
real actred, epsmch, prered;
int info;
/* ********** */
/* subroutine hybrd */
/* the purpose of hybrd is to find a zero of a system of */
/* n nonlinear functions in n variables by a modification */
/* of the powell hybrid method. 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 hybrd(fcn,n,x,fvec,xtol,maxfev,ml,mu,epsfcn, */
/* diag,mode,factor,nprint,info,nfev,fjac, */
/* ldfjac,r,lr,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(n,x,fvec,iflag) */
/* integer n,iflag */
/* double precision x(n),fvec(n) */
/* ---------- */
/* 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 hybrd. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* 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 n which contains */
/* the functions evaluated at the output x. */
/* xtol is a nonnegative input variable. termination */
/* occurs when the relative error between two consecutive */
/* iterates is at most xtol. */
/* 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. */
/* ml is a nonnegative integer input variable which specifies */
/* the number of subdiagonals within the band of the */
/* jacobian matrix. if the jacobian is not banded, set */
/* ml to at least n - 1. */
/* mu is a nonnegative integer input variable which specifies */
/* the number of superdiagonals within the band of the */
/* jacobian matrix. if the jacobian is not banded, set */
/* mu to at least n - 1. */
/* 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 relative error between two consecutive iterates */
/* is at most xtol. */
/* info = 2 number of calls to fcn has reached or exceeded */
/* maxfev. */
/* info = 3 xtol is too small. no further improvement in */
/* the approximate solution x is possible. */
/* info = 4 iteration is not making good progress, as */
/* measured by the improvement from the last */
/* five jacobian evaluations. */
/* info = 5 iteration is not making good progress, as */
/* measured by the improvement from the last */
/* ten iterations. */
/* nfev is an integer output variable set to the number of */
/* calls to fcn. */
/* fjac is an output n by n array which contains the */
/* orthogonal matrix q produced by the qr factorization */
/* of the final approximate jacobian. */
/* ldfjac is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array fjac. */
/* r is an output array of length lr which contains the */
/* upper triangular matrix produced by the qr factorization */
/* of the final approximate jacobian, stored rowwise. */
/* lr is a positive integer input variable not less than */
/* (n*(n+1))/2. */
/* qtf is an output array of length n which contains */
/* the vector (q transpose)*fvec. */
/* wa1, wa2, wa3, and wa4 are work arrays of length n. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dogleg,dpmpar,enorm,fdjac1, */
/* qform,qrfac,r1mpyq,r1updt */
/* fortran-supplied ... dabs,dmax1,dmin1,min0,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa4;
--wa3;
--wa2;
--wa1;
--qtf;
--diag;
--fvec;
--x;
fjac_dim1 = ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
--r;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(1);
info = 0;
iflag = 0;
*nfev = 0;
/* check the input parameters for errors. */
if (n <= 0 || xtol < 0. || maxfev <= 0 || ml < 0 || mu < 0 ||
factor <= 0. || ldfjac < n || lr < n * (n + 1) / 2) {
goto TERMINATE;
}
if (mode == 2) {
for (j = 1; j <= n; ++j) {
if (diag[j] <= 0.) {
goto TERMINATE;
}
}
}
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = fcn_nn(p, n, &x[1], &fvec[1], 1);
*nfev = 1;
if (iflag < 0) {
goto TERMINATE;
}
fnorm = __cminpack_enorm__(n, &fvec[1]);
/* determine the number of calls to fcn needed to compute */
/* the jacobian matrix. */
/* Computing MIN */
i1 = ml + mu + 1;
msum = min(i1,n);
/* initialize iteration counter and monitors. */
iter = 1;
ncsuc = 0;
ncfail = 0;
nslow1 = 0;
nslow2 = 0;
/* beginning of the outer loop. */
for (;;) {
jeval = TRUE_;
/* calculate the jacobian matrix. */
iflag = __cminpack_func__(fdjac1)(__cminpack_param_fcn_nn__ p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac,
ml, mu, epsfcn, &wa1[1], &wa2[1]);
*nfev += msum;
if (iflag < 0) {
goto TERMINATE;
}
/* compute the qr factorization of the jacobian. */
__cminpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, FALSE_, iwa, 1,
&wa1[1], &wa2[1], &wa3[1]);
/* on the first iteration and if mode is 1, scale according */
/* to the norms of the columns of the initial jacobian. */
if (iter == 1) {
if (mode != 2) {
for (j = 1; 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 = 1; j <= n; ++j) {
wa3[j] = diag[j] * x[j];
}
xnorm = __cminpack_enorm__(n, &wa3[1]);
delta = factor * xnorm;
if (delta == 0.) {
delta = factor;
}
}
/* form (q transpose)*fvec and store in qtf. */
for (i = 1; i <= n; ++i) {
qtf[i] = fvec[i];
}
for (j = 1; j <= n; ++j) {
if (fjac[j + j * fjac_dim1] != 0.) {
sum = 0.;
for (i = j; i <= n; ++i) {
sum += fjac[i + j * fjac_dim1] * qtf[i];
}
temp = -sum / fjac[j + j * fjac_dim1];
for (i = j; i <= n; ++i) {
qtf[i] += fjac[i + j * fjac_dim1] * temp;
}
}
}
/* copy the triangular factor of the qr factorization into r. */
sing = FALSE_;
for (j = 1; j <= n; ++j) {
l = j;
jm1 = j - 1;
if (jm1 >= 1) {
for (i = 1; i <= jm1; ++i) {
r[l] = fjac[i + j * fjac_dim1];
l = l + n - i;
}
}
r[l] = wa1[j];
if (wa1[j] == 0.) {
sing = TRUE_;
}
}
/* accumulate the orthogonal factor in fjac. */
__cminpack_func__(qform)(n, n, &fjac[fjac_offset], ldfjac, &wa1[1]);
/* rescale if necessary. */
if (mode != 2) {
for (j = 1; j <= n; ++j) {
/* Computing MAX */
d1 = diag[j], d2 = wa2[j];
diag[j] = max(d1,d2);
}
}
/* beginning of the inner loop. */
for (;;) {
/* if requested, call fcn to enable printing of iterates. */
if (nprint > 0) {
iflag = 0;
if ((iter - 1) % nprint == 0) {
iflag = fcn_nn(p, n, &x[1], &fvec[1], 0);
}
if (iflag < 0) {
goto TERMINATE;
}
}
/* determine the direction p. */
__cminpack_func__(dogleg)(n, &r[1], lr, &diag[1], &qtf[1], delta, &wa1[1], &wa2[1], &wa3[1]);
/* store the direction p and x + p. calculate the norm of p. */
for (j = 1; j <= n; ++j) {
wa1[j] = -wa1[j];
wa2[j] = x[j] + wa1[j];
wa3[j] = diag[j] * wa1[j];
}
pnorm = __cminpack_enorm__(n, &wa3[1]);
/* 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 = fcn_nn(p, n, &wa2[1], &wa4[1], 1);
++(*nfev);
if (iflag < 0) {
goto TERMINATE;
}
fnorm1 = __cminpack_enorm__(n, &wa4[1]);
/* compute the scaled actual reduction. */
actred = -1.;
if (fnorm1 < fnorm) {
/* Computing 2nd power */
d1 = fnorm1 / fnorm;
actred = 1. - d1 * d1;
}
/* compute the scaled predicted reduction. */
l = 1;
for (i = 1; i <= n; ++i) {
sum = 0.;
for (j = i; j <= n; ++j) {
sum += r[l] * wa1[j];
++l;
}
wa3[i] = qtf[i] + sum;
}
temp = __cminpack_enorm__(n, &wa3[1]);
prered = 0.;
if (temp < fnorm) {
/* Computing 2nd power */
d1 = temp / fnorm;
prered = 1. - d1 * d1;
}
/* compute the ratio of the actual to the predicted */
/* reduction. */
ratio = 0.;
if (prered > 0.) {
ratio = actred / prered;
}
/* update the step bound. */
if (ratio < p1) {
ncsuc = 0;
++ncfail;
delta = p5 * delta;
} else {
ncfail = 0;
++ncsuc;
if (ratio >= p5 || ncsuc > 1) {
/* Computing MAX */
d1 = pnorm / p5;
delta = max(delta,d1);
}
if (fabs(ratio - 1.) <= p1) {
delta = pnorm / p5;
}
}
/* test for successful iteration. */
if (ratio >= p0001) {
/* successful iteration. update x, fvec, and their norms. */
for (j = 1; j <= n; ++j) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
fvec[j] = wa4[j];
}
xnorm = __cminpack_enorm__(n, &wa2[1]);
fnorm = fnorm1;
++iter;
}
/* determine the progress of the iteration. */
++nslow1;
if (actred >= p001) {
nslow1 = 0;
}
if (jeval) {
++nslow2;
}
if (actred >= p1) {
nslow2 = 0;
}
/* test for convergence. */
if (delta <= xtol * xnorm || fnorm == 0.) {
info = 1;
}
if (info != 0) {
goto TERMINATE;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= maxfev) {
info = 2;
}
/* Computing MAX */
d1 = p1 * delta;
if (p1 * max(d1,pnorm) <= epsmch * xnorm) {
info = 3;
}
if (nslow2 == 5) {
info = 4;
}
if (nslow1 == 10) {
info = 5;
}
if (info != 0) {
goto TERMINATE;
}
/* criterion for recalculating jacobian approximation */
/* by forward differences. */
if (ncfail == 2) {
goto TERMINATE_INNER_LOOP;
}
/* calculate the rank one modification to the jacobian */
/* and update qtf if necessary. */
for (j = 1; j <= n; ++j) {
sum = 0.;
for (i = 1; i <= n; ++i) {
sum += fjac[i + j * fjac_dim1] * wa4[i];
}
wa2[j] = (sum - wa3[j]) / pnorm;
wa1[j] = diag[j] * (diag[j] * wa1[j] / pnorm);
if (ratio >= p0001) {
qtf[j] = sum;
}
}
/* compute the qr factorization of the updated jacobian. */
__cminpack_func__(r1updt)(n, n, &r[1], lr, &wa1[1], &wa2[1], &wa3[1], &sing);
__cminpack_func__(r1mpyq)(n, n, &fjac[fjac_offset], ldfjac, &wa2[1], &wa3[1]);
__cminpack_func__(r1mpyq)(1, n, &qtf[1], 1, &wa2[1], &wa3[1]);
/* end of the inner loop. */
jeval = FALSE_;
}
TERMINATE_INNER_LOOP:
;
/* end of the outer loop. */
}
TERMINATE:
/* termination, either normal or user imposed. */
if (iflag < 0) {
info = iflag;
}
if (nprint > 0) {
fcn_nn(p, n, &x[1], &fvec[1], 0);
}
return info;
/* last card of subroutine hybrd. */
} /* hybrd_ */

View File

@ -1,148 +0,0 @@
/* hybrd1.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(hybrd1)(__cminpack_decl_fcn_nn__ void *p, int n, real *x, real *
fvec, real tol, real *wa, int lwa)
{
/* Initialized data */
const real factor = 100.;
/* Local variables */
int j, ml, lr, mu, mode, nfev;
real xtol;
int index;
real epsfcn;
int maxfev, nprint;
int info;
/* ********** */
/* subroutine hybrd1 */
/* the purpose of hybrd1 is to find a zero of a system of */
/* n nonlinear functions in n variables by a modification */
/* of the powell hybrid method. this is done by using the */
/* more general nonlinear equation solver hybrd. 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 hybrd1(fcn,n,x,fvec,tol,info,wa,lwa) */
/* 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(n,x,fvec,iflag) */
/* integer n,iflag */
/* double precision x(n),fvec(n) */
/* ---------- */
/* 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 hybrd1. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* 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 n which contains */
/* the functions evaluated at the output x. */
/* tol is a nonnegative input variable. termination occurs */
/* when the algorithm estimates 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 */
/* between x and the solution is at most tol. */
/* info = 2 number of calls to fcn has reached or exceeded */
/* 200*(n+1). */
/* info = 3 tol is too small. no further improvement in */
/* the approximate solution x is possible. */
/* info = 4 iteration is not making good progress. */
/* wa is a work array of length lwa. */
/* lwa is a positive integer input variable not less than */
/* (n*(3*n+13))/2. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... hybrd */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--fvec;
--x;
--wa;
/* Function Body */
/* check the input parameters for errors. */
if (n <= 0 || tol < 0. || lwa < n * (n * 3 + 13) / 2) {
return 0;
}
/* call hybrd. */
maxfev = (n + 1) * 200;
xtol = tol;
ml = n - 1;
mu = n - 1;
epsfcn = 0.;
mode = 2;
for (j = 1; j <= n; ++j) {
wa[j] = 1.;
}
nprint = 0;
lr = n * (n + 1) / 2;
index = n * 6 + lr;
info = __cminpack_func__(hybrd)(__cminpack_param_fcn_nn__ p, n, &x[1], &fvec[1], xtol, maxfev, ml, mu, epsfcn, &
wa[1], mode, factor, nprint, &nfev, &wa[index + 1], n, &
wa[n * 6 + 1], lr, &wa[n + 1], &wa[(n << 1) + 1], &wa[n * 3
+ 1], &wa[(n << 2) + 1], &wa[n * 5 + 1]);
if (info == 5) {
info = 4;
}
return info;
/* last card of subroutine hybrd1. */
} /* hybrd1_ */

View File

@ -1,156 +0,0 @@
/* hybrd1.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(hybrd1)(__minpack_decl_fcn_nn__ const int *n, real *x, real *
fvec, const real *tol, int *info, real *wa, const int *lwa)
{
/* Initialized data */
const real factor = 100.;
/* System generated locals */
int i__1;
/* Local variables */
int j, ml, lr, mu, mode, nfev;
real xtol;
int index;
real epsfcn;
int maxfev, nprint;
/* ********** */
/* subroutine hybrd1 */
/* the purpose of hybrd1 is to find a zero of a system of */
/* n nonlinear functions in n variables by a modification */
/* of the powell hybrid method. this is done by using the */
/* more general nonlinear equation solver hybrd. 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 hybrd1(fcn,n,x,fvec,tol,info,wa,lwa) */
/* 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(n,x,fvec,iflag) */
/* integer n,iflag */
/* double precision x(n),fvec(n) */
/* ---------- */
/* 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 hybrd1. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* 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 n which contains */
/* the functions evaluated at the output x. */
/* tol is a nonnegative input variable. termination occurs */
/* when the algorithm estimates 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 */
/* between x and the solution is at most tol. */
/* info = 2 number of calls to fcn has reached or exceeded */
/* 200*(n+1). */
/* info = 3 tol is too small. no further improvement in */
/* the approximate solution x is possible. */
/* info = 4 iteration is not making good progress. */
/* wa is a work array of length lwa. */
/* lwa is a positive integer input variable not less than */
/* (n*(3*n+13))/2. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... hybrd */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--fvec;
--x;
--wa;
/* Function Body */
*info = 0;
/* check the input parameters for errors. */
if (*n <= 0 || *tol < 0. || *lwa < *n * (*n * 3 + 13) / 2) {
/* goto L20; */
return;
}
/* call hybrd. */
maxfev = (*n + 1) * 200;
xtol = *tol;
ml = *n - 1;
mu = *n - 1;
epsfcn = 0.;
mode = 2;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa[j] = 1.;
/* L10: */
}
nprint = 0;
lr = *n * (*n + 1) / 2;
index = *n * 6 + lr;
__minpack_func__(hybrd)(__minpack_param_fcn_nn__ n, &x[1], &fvec[1], &xtol, &maxfev, &ml, &mu, &epsfcn, &
wa[1], &mode, &factor, &nprint, info, &nfev, &wa[index + 1], n, &
wa[*n * 6 + 1], &lr, &wa[*n + 1], &wa[(*n << 1) + 1], &wa[*n * 3
+ 1], &wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
if (*info == 5) {
*info = 4;
}
/* L20: */
return;
/* last card of subroutine hybrd1. */
} /* hybrd1_ */

View File

@ -1,631 +0,0 @@
/* hybrd.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(hybrd)(__minpack_decl_fcn_nn__ const int *n, real *x, real *
fvec, const real *xtol, const int *maxfev, const int *ml, const int *mu,
const real *epsfcn, real *diag, const int *mode, const real *
factor, const int *nprint, int *info, int *nfev, real *
fjac, const int *ldfjac, real *r__, const int *lr, real *qtf,
real *wa1, real *wa2, real *wa3, real *wa4)
{
/* Table of constant values */
const int c__1 = 1;
const int c_false = FALSE_;
/* Initialized data */
#define p1 .1
#define p5 .5
#define p001 .001
#define p0001 1e-4
/* System generated locals */
int fjac_dim1, fjac_offset, i__1, i__2;
real d__1, d__2;
/* Local variables */
int i__, j, l, jm1, iwa[1];
real sum;
int sing;
int iter;
real temp;
int msum, iflag;
real delta;
int jeval;
int ncsuc;
real ratio;
real fnorm;
real pnorm, xnorm = 0, fnorm1;
int nslow1, nslow2;
int ncfail;
real actred, epsmch, prered;
/* ********** */
/* subroutine hybrd */
/* the purpose of hybrd is to find a zero of a system of */
/* n nonlinear functions in n variables by a modification */
/* of the powell hybrid method. 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 hybrd(fcn,n,x,fvec,xtol,maxfev,ml,mu,epsfcn, */
/* diag,mode,factor,nprint,info,nfev,fjac, */
/* ldfjac,r,lr,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(n,x,fvec,iflag) */
/* integer n,iflag */
/* double precision x(n),fvec(n) */
/* ---------- */
/* 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 hybrd. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* 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 n which contains */
/* the functions evaluated at the output x. */
/* xtol is a nonnegative input variable. termination */
/* occurs when the relative error between two consecutive */
/* iterates is at most xtol. */
/* 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. */
/* ml is a nonnegative integer input variable which specifies */
/* the number of subdiagonals within the band of the */
/* jacobian matrix. if the jacobian is not banded, set */
/* ml to at least n - 1. */
/* mu is a nonnegative integer input variable which specifies */
/* the number of superdiagonals within the band of the */
/* jacobian matrix. if the jacobian is not banded, set */
/* mu to at least n - 1. */
/* 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 relative error between two consecutive iterates */
/* is at most xtol. */
/* info = 2 number of calls to fcn has reached or exceeded */
/* maxfev. */
/* info = 3 xtol is too small. no further improvement in */
/* the approximate solution x is possible. */
/* info = 4 iteration is not making good progress, as */
/* measured by the improvement from the last */
/* five jacobian evaluations. */
/* info = 5 iteration is not making good progress, as */
/* measured by the improvement from the last */
/* ten iterations. */
/* nfev is an integer output variable set to the number of */
/* calls to fcn. */
/* fjac is an output n by n array which contains the */
/* orthogonal matrix q produced by the qr factorization */
/* of the final approximate jacobian. */
/* ldfjac is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array fjac. */
/* r is an output array of length lr which contains the */
/* upper triangular matrix produced by the qr factorization */
/* of the final approximate jacobian, stored rowwise. */
/* lr is a positive integer input variable not less than */
/* (n*(n+1))/2. */
/* qtf is an output array of length n which contains */
/* the vector (q transpose)*fvec. */
/* wa1, wa2, wa3, and wa4 are work arrays of length n. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dogleg,dpmpar,enorm,fdjac1, */
/* qform,qrfac,r1mpyq,r1updt */
/* fortran-supplied ... dabs,dmax1,dmin1,min0,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa4;
--wa3;
--wa2;
--wa1;
--qtf;
--diag;
--fvec;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
--r__;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(dpmpar)(&c__1);
*info = 0;
iflag = 0;
*nfev = 0;
/* check the input parameters for errors. */
if (*n <= 0 || *xtol < 0. || *maxfev <= 0 || *ml < 0 || *mu < 0 || *
factor <= 0. || *ldfjac < *n || *lr < *n * (*n + 1) / 2) {
goto L300;
}
if (*mode != 2) {
goto L20;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (diag[j] <= 0.) {
goto L300;
}
/* L10: */
}
L20:
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = 1;
fcn_nn(n, &x[1], &fvec[1], &iflag);
*nfev = 1;
if (iflag < 0) {
goto L300;
}
fnorm = __minpack_func__(enorm)(n, &fvec[1]);
/* determine the number of calls to fcn needed to compute */
/* the jacobian matrix. */
/* Computing MIN */
i__1 = *ml + *mu + 1;
msum = min(i__1,*n);
/* initialize iteration counter and monitors. */
iter = 1;
ncsuc = 0;
ncfail = 0;
nslow1 = 0;
nslow2 = 0;
/* beginning of the outer loop. */
L30:
jeval = TRUE_;
/* calculate the jacobian matrix. */
iflag = 2;
__minpack_func__(fdjac1)(__minpack_param_fcn_nn__ n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag,
ml, mu, epsfcn, &wa1[1], &wa2[1]);
*nfev += msum;
if (iflag < 0) {
goto L300;
}
/* compute the qr factorization of the jacobian. */
__minpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, &c_false, iwa, &c__1, &wa1[1], &
wa2[1], &wa3[1]);
/* 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 L70;
}
if (*mode == 2) {
goto L50;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
diag[j] = wa2[j];
if (wa2[j] == 0.) {
diag[j] = 1.;
}
/* L40: */
}
L50:
/* on the first iteration, calculate the norm of the scaled x */
/* and initialize the step bound delta. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa3[j] = diag[j] * x[j];
/* L60: */
}
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
delta = *factor * xnorm;
if (delta == 0.) {
delta = *factor;
}
L70:
/* form (q transpose)*fvec and store in qtf. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
qtf[i__] = fvec[i__];
/* L80: */
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (fjac[j + j * fjac_dim1] == 0.) {
goto L110;
}
sum = 0.;
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * qtf[i__];
/* L90: */
}
temp = -sum / fjac[j + j * fjac_dim1];
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
qtf[i__] += fjac[i__ + j * fjac_dim1] * temp;
/* L100: */
}
L110:
/* L120: */
;
}
/* copy the triangular factor of the qr factorization into r. */
sing = FALSE_;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
l = j;
jm1 = j - 1;
if (jm1 < 1) {
goto L140;
}
i__2 = jm1;
for (i__ = 1; i__ <= i__2; ++i__) {
r__[l] = fjac[i__ + j * fjac_dim1];
l = l + *n - i__;
/* L130: */
}
L140:
r__[l] = wa1[j];
if (wa1[j] == 0.) {
sing = TRUE_;
}
/* L150: */
}
/* accumulate the orthogonal factor in fjac. */
__minpack_func__(qform)(n, n, &fjac[fjac_offset], ldfjac, &wa1[1]);
/* rescale if necessary. */
if (*mode == 2) {
goto L170;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
d__1 = diag[j], d__2 = wa2[j];
diag[j] = max(d__1,d__2);
/* L160: */
}
L170:
/* beginning of the inner loop. */
L180:
/* if requested, call fcn to enable printing of iterates. */
if (*nprint <= 0) {
goto L190;
}
iflag = 0;
if ((iter - 1) % *nprint == 0) {
fcn_nn(n, &x[1], &fvec[1], &iflag);
}
if (iflag < 0) {
goto L300;
}
L190:
/* determine the direction p. */
__minpack_func__(dogleg)(n, &r__[1], lr, &diag[1], &qtf[1], &delta, &wa1[1], &wa2[1], &wa3[
1]);
/* store the direction p and x + p. calculate the norm of p. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] = -wa1[j];
wa2[j] = x[j] + wa1[j];
wa3[j] = diag[j] * wa1[j];
/* L200: */
}
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
/* 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_nn(n, &wa2[1], &wa4[1], &iflag);
++(*nfev);
if (iflag < 0) {
goto L300;
}
fnorm1 = __minpack_func__(enorm)(n, &wa4[1]);
/* compute the scaled actual reduction. */
actred = -1.;
if (fnorm1 < fnorm) {
/* Computing 2nd power */
d__1 = fnorm1 / fnorm;
actred = 1. - d__1 * d__1;
}
/* compute the scaled predicted reduction. */
l = 1;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
sum = 0.;
i__2 = *n;
for (j = i__; j <= i__2; ++j) {
sum += r__[l] * wa1[j];
++l;
/* L210: */
}
wa3[i__] = qtf[i__] + sum;
/* L220: */
}
temp = __minpack_func__(enorm)(n, &wa3[1]);
prered = 0.;
if (temp < fnorm) {
/* Computing 2nd power */
d__1 = temp / fnorm;
prered = 1. - d__1 * d__1;
}
/* compute the ratio of the actual to the predicted */
/* reduction. */
ratio = 0.;
if (prered > 0.) {
ratio = actred / prered;
}
/* update the step bound. */
if (ratio >= p1) {
goto L230;
}
ncsuc = 0;
++ncfail;
delta = p5 * delta;
goto L240;
L230:
ncfail = 0;
++ncsuc;
if (ratio >= p5 || ncsuc > 1) {
/* Computing MAX */
d__1 = delta, d__2 = pnorm / p5;
delta = max(d__1,d__2);
}
if (fabs(ratio - 1.) <= p1) {
delta = pnorm / p5;
}
L240:
/* test for successful iteration. */
if (ratio < p0001) {
goto L260;
}
/* successful iteration. update x, fvec, and their norms. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
fvec[j] = wa4[j];
/* L250: */
}
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
fnorm = fnorm1;
++iter;
L260:
/* determine the progress of the iteration. */
++nslow1;
if (actred >= p001) {
nslow1 = 0;
}
if (jeval) {
++nslow2;
}
if (actred >= p1) {
nslow2 = 0;
}
/* test for convergence. */
if (delta <= *xtol * xnorm || fnorm == 0.) {
*info = 1;
}
if (*info != 0) {
goto L300;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= *maxfev) {
*info = 2;
}
/* Computing MAX */
d__1 = p1 * delta;
if (p1 * max(d__1,pnorm) <= epsmch * xnorm) {
*info = 3;
}
if (nslow2 == 5) {
*info = 4;
}
if (nslow1 == 10) {
*info = 5;
}
if (*info != 0) {
goto L300;
}
/* criterion for recalculating jacobian approximation */
/* by forward differences. */
if (ncfail == 2) {
goto L290;
}
/* calculate the rank one modification to the jacobian */
/* and update qtf if necessary. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
sum = 0.;
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * wa4[i__];
/* L270: */
}
wa2[j] = (sum - wa3[j]) / pnorm;
wa1[j] = diag[j] * (diag[j] * wa1[j] / pnorm);
if (ratio >= p0001) {
qtf[j] = sum;
}
/* L280: */
}
/* compute the qr factorization of the updated jacobian. */
__minpack_func__(r1updt)(n, n, &r__[1], lr, &wa1[1], &wa2[1], &wa3[1], &sing);
__minpack_func__(r1mpyq)(n, n, &fjac[fjac_offset], ldfjac, &wa2[1], &wa3[1]);
__minpack_func__(r1mpyq)(&c__1, n, &qtf[1], &c__1, &wa2[1], &wa3[1]);
/* end of the inner loop. */
jeval = FALSE_;
goto L180;
L290:
/* 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_nn(n, &x[1], &fvec[1], &iflag);
}
return;
/* last card of subroutine hybrd. */
} /* hybrd_ */

View File

@ -1,549 +0,0 @@
/* hybrj.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(hybrj)(__cminpack_decl_fcnder_nn__ void *p, int n, real *x, real *
fvec, real *fjac, int ldfjac, real xtol, int
maxfev, real *diag, int mode, real factor, int
nprint, int *nfev, int *njev, real *r,
int lr, real *qtf, real *wa1, real *wa2,
real *wa3, real *wa4)
{
/* Initialized data */
#define p1 .1
#define p5 .5
#define p001 .001
#define p0001 1e-4
/* System generated locals */
int fjac_dim1, fjac_offset;
real d1, d2;
/* Local variables */
int i, j, l, jm1, iwa[1];
real sum;
int sing;
int iter;
real temp;
int iflag;
real delta = 0.;
int jeval;
int ncsuc;
real ratio;
real fnorm;
real pnorm, xnorm = 0., fnorm1;
int nslow1, nslow2;
int ncfail;
real actred, epsmch, prered;
int info;
/* ********** */
/* subroutine hybrj */
/* the purpose of hybrj is to find a zero of a system of */
/* n nonlinear functions in n variables by a modification */
/* of the powell hybrid method. the user must provide a */
/* subroutine which calculates the functions and the jacobian. */
/* the subroutine statement is */
/* subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag, */
/* mode,factor,nprint,info,nfev,njev,r,lr,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(n,x,fvec,fjac,ldfjac,iflag) */
/* integer n,ldfjac,iflag */
/* double precision x(n),fvec(n),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 hybrj. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* 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 n which contains */
/* the functions evaluated at the output x. */
/* fjac is an output n by n array which contains the */
/* orthogonal matrix q produced by the qr factorization */
/* of the final approximate jacobian. */
/* ldfjac is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array fjac. */
/* xtol is a nonnegative input variable. termination */
/* occurs when the relative error between two consecutive */
/* iterates is at most xtol. */
/* 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 and fvec 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 relative error between two consecutive iterates */
/* is at most xtol. */
/* info = 2 number of calls to fcn with iflag = 1 has */
/* reached maxfev. */
/* info = 3 xtol is too small. no further improvement in */
/* the approximate solution x is possible. */
/* info = 4 iteration is not making good progress, as */
/* measured by the improvement from the last */
/* five jacobian evaluations. */
/* info = 5 iteration is not making good progress, as */
/* measured by the improvement from the last */
/* ten iterations. */
/* 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. */
/* r is an output array of length lr which contains the */
/* upper triangular matrix produced by the qr factorization */
/* of the final approximate jacobian, stored rowwise. */
/* lr is a positive integer input variable not less than */
/* (n*(n+1))/2. */
/* qtf is an output array of length n which contains */
/* the vector (q transpose)*fvec. */
/* wa1, wa2, wa3, and wa4 are work arrays of length n. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dogleg,dpmpar,enorm, */
/* qform,qrfac,r1mpyq,r1updt */
/* fortran-supplied ... dabs,dmax1,dmin1,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa4;
--wa3;
--wa2;
--wa1;
--qtf;
--diag;
--fvec;
--x;
fjac_dim1 = ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
--r;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(1);
info = 0;
iflag = 0;
*nfev = 0;
*njev = 0;
/* check the input parameters for errors. */
if (n <= 0 || ldfjac < n || xtol < 0. || maxfev <= 0 || factor <=
0. || lr < n * (n + 1) / 2) {
goto TERMINATE;
}
if (mode == 2) {
for (j = 1; j <= n; ++j) {
if (diag[j] <= 0.) {
goto TERMINATE;
}
}
}
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = fcnder_nn(p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, 1);
*nfev = 1;
if (iflag < 0) {
goto TERMINATE;
}
fnorm = __cminpack_enorm__(n, &fvec[1]);
/* initialize iteration counter and monitors. */
iter = 1;
ncsuc = 0;
ncfail = 0;
nslow1 = 0;
nslow2 = 0;
/* beginning of the outer loop. */
for (;;) {
jeval = TRUE_;
/* calculate the jacobian matrix. */
iflag = fcnder_nn(p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, 2);
++(*njev);
if (iflag < 0) {
goto TERMINATE;
}
/* compute the qr factorization of the jacobian. */
__cminpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, FALSE_, iwa, 1,
&wa1[1], &wa2[1], &wa3[1]);
/* on the first iteration and if mode is 1, scale according */
/* to the norms of the columns of the initial jacobian. */
if (iter == 1) {
if (mode != 2) {
for (j = 1; 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 = 1; j <= n; ++j) {
wa3[j] = diag[j] * x[j];
}
xnorm = __cminpack_enorm__(n, &wa3[1]);
delta = factor * xnorm;
if (delta == 0.) {
delta = factor;
}
}
/* form (q transpose)*fvec and store in qtf. */
for (i = 1; i <= n; ++i) {
qtf[i] = fvec[i];
}
for (j = 1; j <= n; ++j) {
if (fjac[j + j * fjac_dim1] != 0.) {
sum = 0.;
for (i = j; i <= n; ++i) {
sum += fjac[i + j * fjac_dim1] * qtf[i];
}
temp = -sum / fjac[j + j * fjac_dim1];
for (i = j; i <= n; ++i) {
qtf[i] += fjac[i + j * fjac_dim1] * temp;
}
}
}
/* copy the triangular factor of the qr factorization into r. */
sing = FALSE_;
for (j = 1; j <= n; ++j) {
l = j;
jm1 = j - 1;
if (jm1 >= 1) {
for (i = 1; i <= jm1; ++i) {
r[l] = fjac[i + j * fjac_dim1];
l = l + n - i;
}
}
r[l] = wa1[j];
if (wa1[j] == 0.) {
sing = TRUE_;
}
}
/* accumulate the orthogonal factor in fjac. */
__cminpack_func__(qform)(n, n, &fjac[fjac_offset], ldfjac, &wa1[1]);
/* rescale if necessary. */
if (mode != 2) {
for (j = 1; j <= n; ++j) {
/* Computing MAX */
d1 = diag[j], d2 = wa2[j];
diag[j] = max(d1,d2);
}
}
/* beginning of the inner loop. */
for (;;) {
/* if requested, call fcn to enable printing of iterates. */
if (nprint > 0) {
iflag = 0;
if ((iter - 1) % nprint == 0) {
iflag = fcnder_nn(p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, 0);
}
if (iflag < 0) {
goto TERMINATE;
}
}
/* determine the direction p. */
__cminpack_func__(dogleg)(n, &r[1], lr, &diag[1], &qtf[1], delta, &wa1[1], &wa2[1], &wa3[1]);
/* store the direction p and x + p. calculate the norm of p. */
for (j = 1; j <= n; ++j) {
wa1[j] = -wa1[j];
wa2[j] = x[j] + wa1[j];
wa3[j] = diag[j] * wa1[j];
}
pnorm = __cminpack_enorm__(n, &wa3[1]);
/* 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 = fcnder_nn(p, n, &wa2[1], &wa4[1], &fjac[fjac_offset], ldfjac, 1);
++(*nfev);
if (iflag < 0) {
goto TERMINATE;
}
fnorm1 = __cminpack_enorm__(n, &wa4[1]);
/* compute the scaled actual reduction. */
actred = -1.;
if (fnorm1 < fnorm) {
/* Computing 2nd power */
d1 = fnorm1 / fnorm;
actred = 1. - d1 * d1;
}
/* compute the scaled predicted reduction. */
l = 1;
for (i = 1; i <= n; ++i) {
sum = 0.;
for (j = i; j <= n; ++j) {
sum += r[l] * wa1[j];
++l;
}
wa3[i] = qtf[i] + sum;
}
temp = __cminpack_enorm__(n, &wa3[1]);
prered = 0.;
if (temp < fnorm) {
/* Computing 2nd power */
d1 = temp / fnorm;
prered = 1. - d1 * d1;
}
/* compute the ratio of the actual to the predicted */
/* reduction. */
ratio = 0.;
if (prered > 0.) {
ratio = actred / prered;
}
/* update the step bound. */
if (ratio < p1) {
ncsuc = 0;
++ncfail;
delta = p5 * delta;
} else {
ncfail = 0;
++ncsuc;
if (ratio >= p5 || ncsuc > 1) {
/* Computing MAX */
d1 = pnorm / p5;
delta = max(delta,d1);
}
if (fabs(ratio - 1.) <= p1) {
delta = pnorm / p5;
}
}
/* test for successful iteration. */
if (ratio >= p0001) {
/* successful iteration. update x, fvec, and their norms. */
for (j = 1; j <= n; ++j) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
fvec[j] = wa4[j];
}
xnorm = __cminpack_enorm__(n, &wa2[1]);
fnorm = fnorm1;
++iter;
}
/* determine the progress of the iteration. */
++nslow1;
if (actred >= p001) {
nslow1 = 0;
}
if (jeval) {
++nslow2;
}
if (actred >= p1) {
nslow2 = 0;
}
/* test for convergence. */
if (delta <= xtol * xnorm || fnorm == 0.) {
info = 1;
}
if (info != 0) {
goto TERMINATE;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= maxfev) {
info = 2;
}
/* Computing MAX */
d1 = p1 * delta;
if (p1 * max(d1,pnorm) <= epsmch * xnorm) {
info = 3;
}
if (nslow2 == 5) {
info = 4;
}
if (nslow1 == 10) {
info = 5;
}
if (info != 0) {
goto TERMINATE;
}
/* criterion for recalculating jacobian. */
if (ncfail == 2) {
goto TERMINATE_INNER_LOOP;
}
/* calculate the rank one modification to the jacobian */
/* and update qtf if necessary. */
for (j = 1; j <= n; ++j) {
sum = 0.;
for (i = 1; i <= n; ++i) {
sum += fjac[i + j * fjac_dim1] * wa4[i];
}
wa2[j] = (sum - wa3[j]) / pnorm;
wa1[j] = diag[j] * (diag[j] * wa1[j] / pnorm);
if (ratio >= p0001) {
qtf[j] = sum;
}
}
/* compute the qr factorization of the updated jacobian. */
__cminpack_func__(r1updt)(n, n, &r[1], lr, &wa1[1], &wa2[1], &wa3[1], &sing);
__cminpack_func__(r1mpyq)(n, n, &fjac[fjac_offset], ldfjac, &wa2[1], &wa3[1]);
__cminpack_func__(r1mpyq)(1, n, &qtf[1], 1, &wa2[1], &wa3[1]);
/* end of the inner loop. */
jeval = FALSE_;
}
TERMINATE_INNER_LOOP:
;
/* end of the outer loop. */
}
TERMINATE:
/* termination, either normal or user imposed. */
if (iflag < 0) {
info = iflag;
}
if (nprint > 0) {
fcnder_nn(p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, 0);
}
return info;
/* last card of subroutine hybrj. */
} /* hybrj_ */

View File

@ -1,158 +0,0 @@
/* hybrj1.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(hybrj1)(__cminpack_decl_fcnder_nn__ void *p, int n, real *x, real *
fvec, real *fjac, int ldfjac, real tol,
real *wa, int lwa)
{
/* Initialized data */
const real factor = 100.;
/* System generated locals */
int fjac_dim1, fjac_offset;
/* Local variables */
int j, lr, mode, nfev, njev;
real xtol;
int maxfev, nprint;
int info;
/* ********** */
/* subroutine hybrj1 */
/* the purpose of hybrj1 is to find a zero of a system of */
/* n nonlinear functions in n variables by a modification */
/* of the powell hybrid method. this is done by using the */
/* more general nonlinear equation solver hybrj. the user */
/* must provide a subroutine which calculates the functions */
/* and the jacobian. */
/* the subroutine statement is */
/* subroutine hybrj1(fcn,n,x,fvec,fjac,ldfjac,tol,info,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(n,x,fvec,fjac,ldfjac,iflag) */
/* integer n,ldfjac,iflag */
/* double precision x(n),fvec(n),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 hybrj1. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* 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 n which contains */
/* the functions evaluated at the output x. */
/* fjac is an output n by n array which contains the */
/* orthogonal matrix q produced by the qr factorization */
/* of the final approximate jacobian. */
/* ldfjac is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array fjac. */
/* tol is a nonnegative input variable. termination occurs */
/* when the algorithm estimates 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 */
/* between x and the solution is at most tol. */
/* info = 2 number of calls to fcn with iflag = 1 has */
/* reached 100*(n+1). */
/* info = 3 tol is too small. no further improvement in */
/* the approximate solution x is possible. */
/* info = 4 iteration is not making good progress. */
/* wa is a work array of length lwa. */
/* lwa is a positive integer input variable not less than */
/* (n*(n+13))/2. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... hybrj */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--fvec;
--x;
fjac_dim1 = ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
--wa;
/* Function Body */
/* check the input parameters for errors. */
if (n <= 0 || ldfjac < n || tol < 0. || lwa < n * (n + 13) / 2) {
return 0;
}
/* call hybrj. */
maxfev = (n + 1) * 100;
xtol = tol;
mode = 2;
for (j = 1; j <= n; ++j) {
wa[j] = 1.;
/* L10: */
}
nprint = 0;
lr = n * (n + 1) / 2;
info = __cminpack_func__(hybrj)(__cminpack_param_fcnder_nn__ p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, xtol,
maxfev, &wa[1], mode, factor, nprint, &nfev, &njev, &wa[
n * 6 + 1], lr, &wa[n + 1], &wa[(n << 1) + 1], &wa[n * 3 + 1],
&wa[(n << 2) + 1], &wa[n * 5 + 1]);
if (info == 5) {
info = 4;
}
return info;
/* last card of subroutine hybrj1. */
} /* hybrj1_ */

View File

@ -1,163 +0,0 @@
/* hybrj1.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(hybrj1)(__minpack_decl_fcnder_nn__ const int *n, real *x, real *
fvec, real *fjac, const int *ldfjac, const real *tol, int *
info, real *wa, const int *lwa)
{
/* Initialized data */
const real factor = 100.;
/* System generated locals */
int fjac_dim1, fjac_offset, i__1;
/* Local variables */
int j, lr, mode, nfev, njev;
real xtol;
int maxfev, nprint;
/* ********** */
/* subroutine hybrj1 */
/* the purpose of hybrj1 is to find a zero of a system of */
/* n nonlinear functions in n variables by a modification */
/* of the powell hybrid method. this is done by using the */
/* more general nonlinear equation solver hybrj. the user */
/* must provide a subroutine which calculates the functions */
/* and the jacobian. */
/* the subroutine statement is */
/* subroutine hybrj1(fcn,n,x,fvec,fjac,ldfjac,tol,info,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(n,x,fvec,fjac,ldfjac,iflag) */
/* integer n,ldfjac,iflag */
/* double precision x(n),fvec(n),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 hybrj1. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* 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 n which contains */
/* the functions evaluated at the output x. */
/* fjac is an output n by n array which contains the */
/* orthogonal matrix q produced by the qr factorization */
/* of the final approximate jacobian. */
/* ldfjac is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array fjac. */
/* tol is a nonnegative input variable. termination occurs */
/* when the algorithm estimates 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 */
/* between x and the solution is at most tol. */
/* info = 2 number of calls to fcn with iflag = 1 has */
/* reached 100*(n+1). */
/* info = 3 tol is too small. no further improvement in */
/* the approximate solution x is possible. */
/* info = 4 iteration is not making good progress. */
/* wa is a work array of length lwa. */
/* lwa is a positive integer input variable not less than */
/* (n*(n+13))/2. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... hybrj */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--fvec;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
--wa;
/* Function Body */
*info = 0;
/* check the input parameters for errors. */
if (*n <= 0 || *ldfjac < *n || *tol < 0. || *lwa < *n * (*n + 13) / 2) {
/* goto L20; */
return;
}
/* call hybrj. */
maxfev = (*n + 1) * 100;
xtol = *tol;
mode = 2;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa[j] = 1.;
/* L10: */
}
nprint = 0;
lr = *n * (*n + 1) / 2;
__minpack_func__(hybrj)(__minpack_param_fcnder_nn__ n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &xtol, &
maxfev, &wa[1], &mode, &factor, &nprint, info, &nfev, &njev, &wa[*
n * 6 + 1], &lr, &wa[*n + 1], &wa[(*n << 1) + 1], &wa[*n * 3 + 1],
&wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
if (*info == 5) {
*info = 4;
}
/* L20: */
return;
/* last card of subroutine hybrj1. */
} /* hybrj1_ */

View File

@ -1,608 +0,0 @@
/* hybrj.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(hybrj)(__minpack_decl_fcnder_nn__ const int *n, real *x, real *
fvec, real *fjac, const int *ldfjac, const real *xtol, const int *
maxfev, real *diag, const int *mode, const real *factor, const int *
nprint, int *info, int *nfev, int *njev, real *r__,
const int *lr, real *qtf, real *wa1, real *wa2,
real *wa3, real *wa4)
{
/* Initialized data */
#define p1 .1
#define p5 .5
#define p001 .001
#define p0001 1e-4
const int c_false = FALSE_;
const int c__1 = 1;
/* System generated locals */
int fjac_dim1, fjac_offset, i__1, i__2;
real d__1, d__2;
/* Local variables */
int i__, j, l, jm1, iwa[1];
real sum;
int sing;
int iter;
real temp;
int iflag;
real delta;
int jeval;
int ncsuc;
real ratio;
real fnorm;
real pnorm, xnorm = 0, fnorm1;
int nslow1, nslow2;
int ncfail;
real actred, epsmch, prered;
/* ********** */
/* subroutine hybrj */
/* the purpose of hybrj is to find a zero of a system of */
/* n nonlinear functions in n variables by a modification */
/* of the powell hybrid method. the user must provide a */
/* subroutine which calculates the functions and the jacobian. */
/* the subroutine statement is */
/* subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag, */
/* mode,factor,nprint,info,nfev,njev,r,lr,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(n,x,fvec,fjac,ldfjac,iflag) */
/* integer n,ldfjac,iflag */
/* double precision x(n),fvec(n),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 hybrj. */
/* in this case set iflag to a negative integer. */
/* n is a positive integer input variable set to the number */
/* of functions and variables. */
/* 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 n which contains */
/* the functions evaluated at the output x. */
/* fjac is an output n by n array which contains the */
/* orthogonal matrix q produced by the qr factorization */
/* of the final approximate jacobian. */
/* ldfjac is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array fjac. */
/* xtol is a nonnegative input variable. termination */
/* occurs when the relative error between two consecutive */
/* iterates is at most xtol. */
/* 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 and fvec 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 relative error between two consecutive iterates */
/* is at most xtol. */
/* info = 2 number of calls to fcn with iflag = 1 has */
/* reached maxfev. */
/* info = 3 xtol is too small. no further improvement in */
/* the approximate solution x is possible. */
/* info = 4 iteration is not making good progress, as */
/* measured by the improvement from the last */
/* five jacobian evaluations. */
/* info = 5 iteration is not making good progress, as */
/* measured by the improvement from the last */
/* ten iterations. */
/* 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. */
/* r is an output array of length lr which contains the */
/* upper triangular matrix produced by the qr factorization */
/* of the final approximate jacobian, stored rowwise. */
/* lr is a positive integer input variable not less than */
/* (n*(n+1))/2. */
/* qtf is an output array of length n which contains */
/* the vector (q transpose)*fvec. */
/* wa1, wa2, wa3, and wa4 are work arrays of length n. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dogleg,dpmpar,enorm, */
/* qform,qrfac,r1mpyq,r1updt */
/* fortran-supplied ... dabs,dmax1,dmin1,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa4;
--wa3;
--wa2;
--wa1;
--qtf;
--diag;
--fvec;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
--r__;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(dpmpar)(&c__1);
*info = 0;
iflag = 0;
*nfev = 0;
*njev = 0;
/* check the input parameters for errors. */
if (*n <= 0 || *ldfjac < *n || *xtol < 0. || *maxfev <= 0 || *factor <=
0. || *lr < *n * (*n + 1) / 2) {
goto L300;
}
if (*mode != 2) {
goto L20;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (diag[j] <= 0.) {
goto L300;
}
/* L10: */
}
L20:
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = 1;
fcnder_nn(n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
*nfev = 1;
if (iflag < 0) {
goto L300;
}
fnorm = __minpack_func__(enorm)(n, &fvec[1]);
/* initialize iteration counter and monitors. */
iter = 1;
ncsuc = 0;
ncfail = 0;
nslow1 = 0;
nslow2 = 0;
/* beginning of the outer loop. */
L30:
jeval = TRUE_;
/* calculate the jacobian matrix. */
iflag = 2;
fcnder_nn(n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
++(*njev);
if (iflag < 0) {
goto L300;
}
/* compute the qr factorization of the jacobian. */
__minpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, &c_false, iwa, &c__1, &wa1[1], &
wa2[1], &wa3[1]);
/* 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 L70;
}
if (*mode == 2) {
goto L50;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
diag[j] = wa2[j];
if (wa2[j] == 0.) {
diag[j] = 1.;
}
/* L40: */
}
L50:
/* on the first iteration, calculate the norm of the scaled x */
/* and initialize the step bound delta. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa3[j] = diag[j] * x[j];
/* L60: */
}
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
delta = *factor * xnorm;
if (delta == 0.) {
delta = *factor;
}
L70:
/* form (q transpose)*fvec and store in qtf. */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
qtf[i__] = fvec[i__];
/* L80: */
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (fjac[j + j * fjac_dim1] == 0.) {
goto L110;
}
sum = 0.;
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * qtf[i__];
/* L90: */
}
temp = -sum / fjac[j + j * fjac_dim1];
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
qtf[i__] += fjac[i__ + j * fjac_dim1] * temp;
/* L100: */
}
L110:
/* L120: */
;
}
/* copy the triangular factor of the qr factorization into r. */
sing = FALSE_;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
l = j;
jm1 = j - 1;
if (jm1 < 1) {
goto L140;
}
i__2 = jm1;
for (i__ = 1; i__ <= i__2; ++i__) {
r__[l] = fjac[i__ + j * fjac_dim1];
l = l + *n - i__;
/* L130: */
}
L140:
r__[l] = wa1[j];
if (wa1[j] == 0.) {
sing = TRUE_;
}
/* L150: */
}
/* accumulate the orthogonal factor in fjac. */
__minpack_func__(qform)(n, n, &fjac[fjac_offset], ldfjac, &wa1[1]);
/* rescale if necessary. */
if (*mode == 2) {
goto L170;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
d__1 = diag[j], d__2 = wa2[j];
diag[j] = max(d__1,d__2);
/* L160: */
}
L170:
/* beginning of the inner loop. */
L180:
/* if requested, call fcn to enable printing of iterates. */
if (*nprint <= 0) {
goto L190;
}
iflag = 0;
if ((iter - 1) % *nprint == 0) {
fcnder_nn(n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
}
if (iflag < 0) {
goto L300;
}
L190:
/* determine the direction p. */
__minpack_func__(dogleg)(n, &r__[1], lr, &diag[1], &qtf[1], &delta, &wa1[1], &wa2[1], &wa3[
1]);
/* store the direction p and x + p. calculate the norm of p. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] = -wa1[j];
wa2[j] = x[j] + wa1[j];
wa3[j] = diag[j] * wa1[j];
/* L200: */
}
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
/* 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;
fcnder_nn(n, &wa2[1], &wa4[1], &fjac[fjac_offset], ldfjac, &iflag);
++(*nfev);
if (iflag < 0) {
goto L300;
}
fnorm1 = __minpack_func__(enorm)(n, &wa4[1]);
/* compute the scaled actual reduction. */
actred = -1.;
if (fnorm1 < fnorm) {
/* Computing 2nd power */
d__1 = fnorm1 / fnorm;
actred = 1. - d__1 * d__1;
}
/* compute the scaled predicted reduction. */
l = 1;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
sum = 0.;
i__2 = *n;
for (j = i__; j <= i__2; ++j) {
sum += r__[l] * wa1[j];
++l;
/* L210: */
}
wa3[i__] = qtf[i__] + sum;
/* L220: */
}
temp = __minpack_func__(enorm)(n, &wa3[1]);
prered = 0.;
if (temp < fnorm) {
/* Computing 2nd power */
d__1 = temp / fnorm;
prered = 1. - d__1 * d__1;
}
/* compute the ratio of the actual to the predicted */
/* reduction. */
ratio = 0.;
if (prered > 0.) {
ratio = actred / prered;
}
/* update the step bound. */
if (ratio >= p1) {
goto L230;
}
ncsuc = 0;
++ncfail;
delta = p5 * delta;
goto L240;
L230:
ncfail = 0;
++ncsuc;
if (ratio >= p5 || ncsuc > 1) {
/* Computing MAX */
d__1 = delta, d__2 = pnorm / p5;
delta = max(d__1,d__2);
}
if (fabs(ratio - 1.) <= p1) {
delta = pnorm / p5;
}
L240:
/* test for successful iteration. */
if (ratio < p0001) {
goto L260;
}
/* successful iteration. update x, fvec, and their norms. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
fvec[j] = wa4[j];
/* L250: */
}
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
fnorm = fnorm1;
++iter;
L260:
/* determine the progress of the iteration. */
++nslow1;
if (actred >= p001) {
nslow1 = 0;
}
if (jeval) {
++nslow2;
}
if (actred >= p1) {
nslow2 = 0;
}
/* test for convergence. */
if (delta <= *xtol * xnorm || fnorm == 0.) {
*info = 1;
}
if (*info != 0) {
goto L300;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= *maxfev) {
*info = 2;
}
/* Computing MAX */
d__1 = p1 * delta;
if (p1 * max(d__1,pnorm) <= epsmch * xnorm) {
*info = 3;
}
if (nslow2 == 5) {
*info = 4;
}
if (nslow1 == 10) {
*info = 5;
}
if (*info != 0) {
goto L300;
}
/* criterion for recalculating jacobian. */
if (ncfail == 2) {
goto L290;
}
/* calculate the rank one modification to the jacobian */
/* and update qtf if necessary. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
sum = 0.;
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * wa4[i__];
/* L270: */
}
wa2[j] = (sum - wa3[j]) / pnorm;
wa1[j] = diag[j] * (diag[j] * wa1[j] / pnorm);
if (ratio >= p0001) {
qtf[j] = sum;
}
/* L280: */
}
/* compute the qr factorization of the updated jacobian. */
__minpack_func__(r1updt)(n, n, &r__[1], lr, &wa1[1], &wa2[1], &wa3[1], &sing);
__minpack_func__(r1mpyq)(n, n, &fjac[fjac_offset], ldfjac, &wa2[1], &wa3[1]);
__minpack_func__(r1mpyq)(&c__1, n, &qtf[1], &c__1, &wa2[1], &wa3[1]);
/* end of the inner loop. */
jeval = FALSE_;
goto L180;
L290:
/* end of the outer loop. */
goto L30;
L300:
/* termination, either normal or user imposed. */
if (iflag < 0) {
*info = iflag;
}
iflag = 0;
if (*nprint > 0) {
fcnder_nn(n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
}
return;
/* last card of subroutine hybrj. */
} /* hybrj_ */

View File

@ -1,526 +0,0 @@
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(lmder)(__cminpack_decl_fcnder_mn__ void *p, int m, int n, real *x,
real *fvec, real *fjac, int ldfjac, real ftol,
real xtol, real gtol, int maxfev, real *
diag, int mode, real factor, int nprint,
int *nfev, int *njev, int *ipvt, real *qtf,
real *wa1, real *wa2, real *wa3, real *wa4)
{
/* Initialized data */
#define p1 .1
#define p5 .5
#define p25 .25
#define p75 .75
#define p0001 1e-4
/* System generated locals */
real d1, d2;
/* Local variables */
int i, j, l;
real par, sum;
int iter;
real temp, temp1, temp2;
int iflag;
real delta = 0.;
real ratio;
real fnorm, gnorm, pnorm, xnorm = 0., fnorm1, actred, dirder,
epsmch, prered;
int info;
/* ********** */
/* 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. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dpmpar,enorm,lmpar,qrfac */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(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 TERMINATE;
}
if (mode == 2) {
for (j = 0; j < n; ++j) {
if (diag[j] <= 0.) {
goto TERMINATE;
}
}
}
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 1);
*nfev = 1;
if (iflag < 0) {
goto TERMINATE;
}
fnorm = __cminpack_enorm__(m, fvec);
/* initialize levenberg-marquardt parameter and iteration counter. */
par = 0.;
iter = 1;
/* beginning of the outer loop. */
for (;;) {
/* calculate the jacobian matrix. */
iflag = fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 2);
++(*njev);
if (iflag < 0) {
goto TERMINATE;
}
/* if requested, call fcn to enable printing of iterates. */
if (nprint > 0) {
iflag = 0;
if ((iter - 1) % nprint == 0) {
iflag = fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 0);
}
if (iflag < 0) {
goto TERMINATE;
}
}
/* compute the qr factorization of the jacobian. */
__cminpack_func__(qrfac)(m, n, fjac, ldfjac, TRUE_, 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) {
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 = __cminpack_enorm__(n, wa3);
delta = factor * xnorm;
if (delta == 0.) {
delta = factor;
}
}
/* 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.) {
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;
}
}
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.) {
sum = 0.;
for (i = 0; i <= j; ++i) {
sum += fjac[i + j * ldfjac] * (qtf[i] / fnorm);
}
/* Computing MAX */
d1 = fabs(sum / wa2[l]);
gnorm = max(gnorm,d1);
}
}
}
/* test for convergence of the gradient norm. */
if (gnorm <= gtol) {
info = 4;
}
if (info != 0) {
goto TERMINATE;
}
/* rescale if necessary. */
if (mode != 2) {
for (j = 0; j < n; ++j) {
/* Computing MAX */
d1 = diag[j], d2 = wa2[j];
diag[j] = max(d1,d2);
}
}
/* beginning of the inner loop. */
do {
/* determine the levenberg-marquardt parameter. */
__cminpack_func__(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 = __cminpack_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 = fcnder_mn(p, m, n, wa2, wa4, fjac, ldfjac, 1);
++(*nfev);
if (iflag < 0) {
goto TERMINATE;
}
fnorm1 = __cminpack_enorm__(m, wa4);
/* compute the scaled actual reduction. */
actred = -1.;
if (p1 * fnorm1 < fnorm) {
/* Computing 2nd power */
d1 = fnorm1 / fnorm;
actred = 1. - d1 * d1;
}
/* 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 = __cminpack_enorm__(n, wa3) / fnorm;
temp2 = (sqrt(par) * pnorm) / fnorm;
prered = temp1 * temp1 + temp2 * temp2 / p5;
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 <= p25) {
if (actred >= 0.) {
temp = p5;
} else {
temp = p5 * dirder / (dirder + p5 * actred);
}
if (p1 * fnorm1 >= fnorm || temp < p1) {
temp = p1;
}
/* Computing MIN */
d1 = pnorm / p1;
delta = temp * min(delta,d1);
par /= temp;
} else {
if (par == 0. || ratio >= p75) {
delta = pnorm / p5;
par = p5 * par;
}
}
/* test for successful iteration. */
if (ratio >= p0001) {
/* 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 = __cminpack_enorm__(n, wa2);
fnorm = fnorm1;
++iter;
}
/* tests for convergence. */
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1.) {
info = 1;
}
if (delta <= xtol * xnorm) {
info = 2;
}
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1. && info == 2) {
info = 3;
}
if (info != 0) {
goto TERMINATE;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= maxfev) {
info = 5;
}
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
info = 6;
}
if (delta <= epsmch * xnorm) {
info = 7;
}
if (gnorm <= epsmch) {
info = 8;
}
if (info != 0) {
goto TERMINATE;
}
/* end of the inner loop. repeat if iteration unsuccessful. */
} while (ratio < p0001);
/* end of the outer loop. */
}
TERMINATE:
/* termination, either normal or user imposed. */
if (iflag < 0) {
info = iflag;
}
if (nprint > 0) {
fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 0);
}
return info;
/* last card of subroutine lmder. */
} /* lmder_ */

View File

@ -1,167 +0,0 @@
#include "cminpack.h"
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(lmder1)(__cminpack_decl_fcnder_mn__ void *p, int m, int n, real *x,
real *fvec, real *fjac, int ldfjac, real tol,
int *ipvt, real *wa, int lwa)
{
/* Initialized data */
const real factor = 100.;
/* Local variables */
int mode, nfev, njev;
real ftol, gtol, xtol;
int maxfev, nprint;
int info;
/* ********** */
/* 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 */
/* ********** */
/* check the input parameters for errors. */
if (n <= 0 || m < n || ldfjac < m || tol < 0. || lwa < n * 5 + m) {
return 0;
}
/* call lmder. */
maxfev = (n + 1) * 100;
ftol = tol;
xtol = tol;
gtol = 0.;
mode = 1;
nprint = 0;
info = __cminpack_func__(lmder)(__cminpack_param_fcnder_mn__ p, m, n, x, fvec, fjac, ldfjac,
ftol, xtol, gtol, maxfev, wa, mode, factor, nprint,
&nfev, &njev, ipvt, &wa[n], &wa[(n << 1)], &
wa[n * 3], &wa[(n << 2)], &wa[n * 5]);
if (info == 8) {
info = 4;
}
return info;
/* last card of subroutine lmder1. */
} /* lmder1_ */

View File

@ -1,190 +0,0 @@
/* lmder1.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(lmder1)(__minpack_decl_fcnder_mn__ const int *m, const int *n, real *x,
real *fvec, real *fjac, const int *ldfjac, const real *tol,
int *info, int *ipvt, real *wa, const int *lwa)
{
/* Initialized data */
const real factor = 100.;
/* System generated locals */
int fjac_dim1, fjac_offset;
/* Local variables */
int mode, nfev, njev;
real ftol, gtol, xtol;
int 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 */
/* ********** */
/* Parameter adjustments */
--fvec;
--ipvt;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
--wa;
/* Function Body */
*info = 0;
/* check the input parameters for errors. */
if (*n <= 0 || *m < *n || *ldfjac < *m || *tol < 0. || *lwa < *n * 5 + *
m) {
/* goto L10; */
return;
}
/* call lmder. */
maxfev = (*n + 1) * 100;
ftol = *tol;
xtol = *tol;
gtol = 0.;
mode = 1;
nprint = 0;
__minpack_func__(lmder)(__minpack_param_fcnder_mn__ m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &
ftol, &xtol, &gtol, &maxfev, &wa[1], &mode, &factor, &nprint,
info, &nfev, &njev, &ipvt[1], &wa[*n + 1], &wa[(*n << 1) + 1], &
wa[*n * 3 + 1], &wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
if (*info == 8) {
*info = 4;
}
/* L10: */
return;
/* last card of subroutine lmder1. */
} /* lmder1_ */

View File

@ -1,621 +0,0 @@
/* lmder.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(lmder)(__minpack_decl_fcnder_mn__ const int *m, const int *n, real *x,
real *fvec, real *fjac, const int *ldfjac, const real *ftol,
const real *xtol, const real *gtol, const int *maxfev, real *
diag, const int *mode, const real *factor, const int *nprint, int *
info, int *nfev, int *njev, int *ipvt, real *qtf,
real *wa1, real *wa2, real *wa3, real *wa4)
{
/* Table of constant values */
const int c__1 = 1;
const int c_true = TRUE_;
/* Initialized data */
#define p1 .1
#define p5 .5
#define p25 .25
#define p75 .75
#define p0001 1e-4
/* System generated locals */
int fjac_dim1, fjac_offset, i__1, i__2;
real d__1, d__2, d__3;
/* Local variables */
int i__, j, l;
real par, sum;
int iter;
real temp, temp1, temp2;
int iflag;
real delta;
real ratio;
real fnorm, gnorm, pnorm, xnorm = 0, fnorm1, actred, dirder,
epsmch, prered;
/* ********** */
/* 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. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dpmpar,enorm,lmpar,qrfac */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa4;
--fvec;
--wa3;
--wa2;
--wa1;
--qtf;
--ipvt;
--diag;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(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) {
goto L20;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (diag[j] <= 0.) {
goto L300;
}
/* L10: */
}
L20:
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = 1;
fcnder_mn(m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
*nfev = 1;
if (iflag < 0) {
goto L300;
}
fnorm = __minpack_func__(enorm)(m, &fvec[1]);
/* initialize levenberg-marquardt parameter and iteration counter. */
par = 0.;
iter = 1;
/* beginning of the outer loop. */
L30:
/* calculate the jacobian matrix. */
iflag = 2;
fcnder_mn(m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
++(*njev);
if (iflag < 0) {
goto L300;
}
/* if requested, call fcn to enable printing of iterates. */
if (*nprint <= 0) {
goto L40;
}
iflag = 0;
if ((iter - 1) % *nprint == 0) {
fcnder_mn(m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
}
if (iflag < 0) {
goto L300;
}
L40:
/* compute the qr factorization of the jacobian. */
__minpack_func__(qrfac)(m, n, &fjac[fjac_offset], ldfjac, &c_true, &ipvt[1], n, &wa1[1], &
wa2[1], &wa3[1]);
/* 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) {
goto L60;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
diag[j] = wa2[j];
if (wa2[j] == 0.) {
diag[j] = 1.;
}
/* L50: */
}
L60:
/* on the first iteration, calculate the norm of the scaled x */
/* and initialize the step bound delta. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa3[j] = diag[j] * x[j];
/* L70: */
}
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
delta = *factor * xnorm;
if (delta == 0.) {
delta = *factor;
}
L80:
/* form (q transpose)*fvec and store the first n components in */
/* qtf. */
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
wa4[i__] = fvec[i__];
/* L90: */
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (fjac[j + j * fjac_dim1] == 0.) {
goto L120;
}
sum = 0.;
i__2 = *m;
for (i__ = j; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * wa4[i__];
/* L100: */
}
temp = -sum / fjac[j + j * fjac_dim1];
i__2 = *m;
for (i__ = j; i__ <= i__2; ++i__) {
wa4[i__] += fjac[i__ + j * fjac_dim1] * temp;
/* L110: */
}
L120:
fjac[j + j * fjac_dim1] = wa1[j];
qtf[j] = wa4[j];
/* L130: */
}
/* compute the norm of the scaled gradient. */
gnorm = 0.;
if (fnorm == 0.) {
goto L170;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
l = ipvt[j];
if (wa2[l] == 0.) {
goto L150;
}
sum = 0.;
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * (qtf[i__] / fnorm);
/* L140: */
}
/* Computing MAX */
d__2 = gnorm, d__3 = fabs(sum / wa2[l]);
gnorm = max(d__2,d__3);
L150:
/* L160: */
;
}
L170:
/* test for convergence of the gradient norm. */
if (gnorm <= *gtol) {
*info = 4;
}
if (*info != 0) {
goto L300;
}
/* rescale if necessary. */
if (*mode == 2) {
goto L190;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
d__1 = diag[j], d__2 = wa2[j];
diag[j] = max(d__1,d__2);
/* L180: */
}
L190:
/* beginning of the inner loop. */
L200:
/* determine the levenberg-marquardt parameter. */
__minpack_func__(lmpar)(n, &fjac[fjac_offset], ldfjac, &ipvt[1], &diag[1], &qtf[1], &delta,
&par, &wa1[1], &wa2[1], &wa3[1], &wa4[1]);
/* store the direction p and x + p. calculate the norm of p. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] = -wa1[j];
wa2[j] = x[j] + wa1[j];
wa3[j] = diag[j] * wa1[j];
/* L210: */
}
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
/* 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;
fcnder_mn(m, n, &wa2[1], &wa4[1], &fjac[fjac_offset], ldfjac, &iflag);
++(*nfev);
if (iflag < 0) {
goto L300;
}
fnorm1 = __minpack_func__(enorm)(m, &wa4[1]);
/* compute the scaled actual reduction. */
actred = -1.;
if (p1 * fnorm1 < fnorm) {
/* Computing 2nd power */
d__1 = fnorm1 / fnorm;
actred = 1. - d__1 * d__1;
}
/* compute the scaled predicted reduction and */
/* the scaled directional derivative. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa3[j] = 0.;
l = ipvt[j];
temp = wa1[l];
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
wa3[i__] += fjac[i__ + j * fjac_dim1] * temp;
/* L220: */
}
/* L230: */
}
temp1 = __minpack_func__(enorm)(n, &wa3[1]) / fnorm;
temp2 = sqrt(par) * pnorm / fnorm;
/* Computing 2nd power */
d__1 = temp1;
/* Computing 2nd power */
d__2 = temp2;
prered = d__1 * d__1 + d__2 * d__2 / p5;
/* Computing 2nd power */
d__1 = temp1;
/* Computing 2nd power */
d__2 = temp2;
dirder = -(d__1 * d__1 + d__2 * d__2);
/* compute the ratio of the actual to the predicted */
/* reduction. */
ratio = 0.;
if (prered != 0.) {
ratio = actred / prered;
}
/* update the step bound. */
if (ratio > p25) {
goto L240;
}
if (actred >= 0.) {
temp = p5;
} else {
temp = p5 * dirder / (dirder + p5 * actred);
}
if (p1 * fnorm1 >= fnorm || temp < p1) {
temp = p1;
}
/* Computing MIN */
d__1 = delta, d__2 = pnorm / p1;
delta = temp * min(d__1,d__2);
par /= temp;
goto L260;
L240:
if (par != 0. && ratio < p75) {
goto L250;
}
delta = pnorm / p5;
par = p5 * par;
L250:
L260:
/* test for successful iteration. */
if (ratio < p0001) {
goto L290;
}
/* successful iteration. update x, fvec, and their norms. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
/* L270: */
}
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
fvec[i__] = wa4[i__];
/* L280: */
}
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
fnorm = fnorm1;
++iter;
L290:
/* tests for convergence. */
if (fabs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1.) {
*info = 1;
}
if (delta <= *xtol * xnorm) {
*info = 2;
}
if (fabs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1. && *info
== 2) {
*info = 3;
}
if (*info != 0) {
goto L300;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= *maxfev) {
*info = 5;
}
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * 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 < p0001) {
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) {
fcnder_mn(m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
}
return;
/* last card of subroutine lmder. */
} /* lmder_ */

View File

@ -1,530 +0,0 @@
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(lmdif)(__cminpack_decl_fcn_mn__ void *p, int m, int n, real *x,
real *fvec, real ftol, real xtol, real
gtol, int maxfev, real epsfcn, real *diag, int
mode, real factor, int nprint, int *
nfev, real *fjac, int ldfjac, int *ipvt, real *
qtf, real *wa1, real *wa2, real *wa3, real *
wa4)
{
/* Initialized data */
#define p1 .1
#define p5 .5
#define p25 .25
#define p75 .75
#define p0001 1e-4
/* System generated locals */
real d1, d2;
/* Local variables */
int i, j, l;
real par, sum;
int iter;
real temp, temp1, temp2;
int iflag;
real delta = 0.;
real ratio;
real fnorm, gnorm;
real pnorm, xnorm = 0., fnorm1, actred, dirder, epsmch, prered;
int info;
/* ********** */
/* 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. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dpmpar,enorm,fdjac2,lmpar,qrfac */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(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 TERMINATE;
}
if (mode == 2) {
for (j = 0; j < n; ++j) {
if (diag[j] <= 0.) {
goto TERMINATE;
}
}
}
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = fcn_mn(p, m, n, x, fvec, 1);
*nfev = 1;
if (iflag < 0) {
goto TERMINATE;
}
fnorm = __cminpack_enorm__(m, fvec);
/* initialize levenberg-marquardt parameter and iteration counter. */
par = 0.;
iter = 1;
/* beginning of the outer loop. */
for (;;) {
/* calculate the jacobian matrix. */
iflag = __cminpack_func__(fdjac2)(__cminpack_param_fcn_mn__ p, m, n, x, fvec, fjac, ldfjac,
epsfcn, wa4);
*nfev += n;
if (iflag < 0) {
goto TERMINATE;
}
/* if requested, call fcn to enable printing of iterates. */
if (nprint > 0) {
iflag = 0;
if ((iter - 1) % nprint == 0) {
iflag = fcn_mn(p, m, n, x, fvec, 0);
}
if (iflag < 0) {
goto TERMINATE;
}
}
/* compute the qr factorization of the jacobian. */
__cminpack_func__(qrfac)(m, n, fjac, ldfjac, TRUE_, 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) {
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 = __cminpack_enorm__(n, wa3);
delta = factor * xnorm;
if (delta == 0.) {
delta = factor;
}
}
/* 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.) {
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;
}
}
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.) {
sum = 0.;
for (i = 0; i <= j; ++i) {
sum += fjac[i + j * ldfjac] * (qtf[i] / fnorm);
}
/* Computing MAX */
d1 = fabs(sum / wa2[l]);
gnorm = max(gnorm,d1);
}
}
}
/* test for convergence of the gradient norm. */
if (gnorm <= gtol) {
info = 4;
}
if (info != 0) {
goto TERMINATE;
}
/* rescale if necessary. */
if (mode != 2) {
for (j = 0; j < n; ++j) {
/* Computing MAX */
d1 = diag[j], d2 = wa2[j];
diag[j] = max(d1,d2);
}
}
/* beginning of the inner loop. */
do {
/* determine the levenberg-marquardt parameter. */
__cminpack_func__(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 = __cminpack_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 = fcn_mn(p, m, n, wa2, wa4, 1);
++(*nfev);
if (iflag < 0) {
goto TERMINATE;
}
fnorm1 = __cminpack_enorm__(m, wa4);
/* compute the scaled actual reduction. */
actred = -1.;
if (p1 * fnorm1 < fnorm) {
/* Computing 2nd power */
d1 = fnorm1 / fnorm;
actred = 1. - d1 * d1;
}
/* 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 = __cminpack_enorm__(n, wa3) / fnorm;
temp2 = (sqrt(par) * pnorm) / fnorm;
prered = temp1 * temp1 + temp2 * temp2 / p5;
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 <= p25) {
if (actred >= 0.) {
temp = p5;
} else {
temp = p5 * dirder / (dirder + p5 * actred);
}
if (p1 * fnorm1 >= fnorm || temp < p1) {
temp = p1;
}
/* Computing MIN */
d1 = pnorm / p1;
delta = temp * min(delta,d1);
par /= temp;
} else {
if (par == 0. || ratio >= p75) {
delta = pnorm / p5;
par = p5 * par;
}
}
/* test for successful iteration. */
if (ratio >= p0001) {
/* 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 = __cminpack_enorm__(n, wa2);
fnorm = fnorm1;
++iter;
}
/* tests for convergence. */
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1.) {
info = 1;
}
if (delta <= xtol * xnorm) {
info = 2;
}
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1. && info == 2) {
info = 3;
}
if (info != 0) {
goto TERMINATE;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= maxfev) {
info = 5;
}
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
info = 6;
}
if (delta <= epsmch * xnorm) {
info = 7;
}
if (gnorm <= epsmch) {
info = 8;
}
if (info != 0) {
goto TERMINATE;
}
/* end of the inner loop. repeat if iteration unsuccessful. */
} while (ratio < p0001);
/* end of the outer loop. */
}
TERMINATE:
/* termination, either normal or user imposed. */
if (iflag < 0) {
info = iflag;
}
if (nprint > 0) {
fcn_mn(p, m, n, x, fvec, 0);
}
return info;
/* last card of subroutine lmdif. */
} /* lmdif_ */

View File

@ -1,147 +0,0 @@
#include "cminpack.h"
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(lmdif1)(__cminpack_decl_fcn_mn__ void *p, int m, int n, real *x,
real *fvec, real tol, int *iwa,
real *wa, int lwa)
{
/* Initialized data */
const real factor = 100.;
int mp5n, mode, nfev;
real ftol, gtol, xtol;
real epsfcn;
int maxfev, nprint;
int info;
/* ********** */
/* subroutine lmdif1 */
/* the purpose of lmdif1 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 lmdif. 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 lmdif1(fcn,m,n,x,fvec,tol,info,iwa,wa,lwa) */
/* 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 lmdif1. */
/* 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. */
/* 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 has reached or */
/* exceeded 200*(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. */
/* iwa is an integer work array of length n. */
/* wa is a work array of length lwa. */
/* lwa is a positive integer input variable not less than */
/* m*n+5*n+m. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... lmdif */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* check the input parameters for errors. */
if (n <= 0 || m < n || tol < 0. || lwa < m * n + n * 5 + m) {
return 0;
}
/* call lmdif. */
maxfev = (n + 1) * 200;
ftol = tol;
xtol = tol;
gtol = 0.;
epsfcn = 0.;
mode = 1;
nprint = 0;
mp5n = m + n * 5;
info = __cminpack_func__(lmdif)(__cminpack_param_fcn_mn__ p, m, n, x, fvec, ftol, xtol, gtol, maxfev,
epsfcn, wa, mode, factor, nprint, &nfev, &wa[mp5n],
m, iwa, &wa[n], &wa[(n << 1)], &wa[n * 3],
&wa[(n << 2)], &wa[n * 5]);
if (info == 8) {
info = 4;
}
return info;
/* last card of subroutine lmdif1. */
} /* lmdif1_ */

View File

@ -1,163 +0,0 @@
/* lmdif1.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(lmdif1)(__minpack_decl_fcn_mn__ const int *m, const int *n, real *x,
real *fvec, const real *tol, int *info, int *iwa,
real *wa, const int *lwa)
{
/* Initialized data */
const real factor = 100.;
int mp5n, mode, nfev;
real ftol, gtol, xtol;
real epsfcn;
int maxfev, nprint;
/* ********** */
/* subroutine lmdif1 */
/* the purpose of lmdif1 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 lmdif. 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 lmdif1(fcn,m,n,x,fvec,tol,info,iwa,wa,lwa) */
/* 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 lmdif1. */
/* 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. */
/* 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 has reached or */
/* exceeded 200*(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. */
/* iwa is an integer work array of length n. */
/* wa is a work array of length lwa. */
/* lwa is a positive integer input variable not less than */
/* m*n+5*n+m. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... lmdif */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--fvec;
--iwa;
--x;
--wa;
/* Function Body */
*info = 0;
/* check the input parameters for errors. */
if (*n <= 0 || *m < *n || *tol < 0. || *lwa < *m * *n + *n * 5 + *m) {
/* goto L10; */
return;
}
/* call lmdif. */
maxfev = (*n + 1) * 200;
ftol = *tol;
xtol = *tol;
gtol = 0.;
epsfcn = 0.;
mode = 1;
nprint = 0;
mp5n = *m + *n * 5;
__minpack_func__(lmdif)(__minpack_param_fcn_mn__ m, n, &x[1], &fvec[1], &ftol, &xtol, &gtol, &maxfev, &
epsfcn, &wa[1], &mode, &factor, &nprint, info, &nfev, &wa[mp5n +
1], m, &iwa[1], &wa[*n + 1], &wa[(*n << 1) + 1], &wa[*n * 3 + 1],
&wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
if (*info == 8) {
*info = 4;
}
/* L10: */
return;
/* last card of subroutine lmdif1. */
} /* lmdif1_ */

View File

@ -1,625 +0,0 @@
/* lmdif.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(lmdif)(__minpack_decl_fcn_mn__ const int *m, const int *n, real *x,
real *fvec, const real *ftol, const real *xtol, const real *
gtol, const int *maxfev, const real *epsfcn, real *diag, const int *
mode, const real *factor, const int *nprint, int *info, int *
nfev, real *fjac, const int *ldfjac, int *ipvt, real *
qtf, real *wa1, real *wa2, real *wa3, real *
wa4)
{
/* Table of constant values */
const int c__1 = 1;
const int c_true = TRUE_;
/* Initialized data */
#define p1 .1
#define p5 .5
#define p25 .25
#define p75 .75
#define p0001 1e-4
/* System generated locals */
int fjac_dim1, fjac_offset, i__1, i__2;
real d__1, d__2, d__3;
/* Local variables */
int i__, j, l;
real par, sum;
int iter;
real temp, temp1, temp2;
int iflag;
real delta;
real ratio;
real fnorm, gnorm;
real pnorm, xnorm = 0, fnorm1, actred, dirder, epsmch, prered;
/* ********** */
/* 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. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dpmpar,enorm,fdjac2,lmpar,qrfac */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa4;
--fvec;
--wa3;
--wa2;
--wa1;
--qtf;
--ipvt;
--diag;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(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) {
goto L20;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (diag[j] <= 0.) {
goto L300;
}
/* L10: */
}
L20:
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = 1;
fcn_mn(m, n, &x[1], &fvec[1], &iflag);
*nfev = 1;
if (iflag < 0) {
goto L300;
}
fnorm = __minpack_func__(enorm)(m, &fvec[1]);
/* initialize levenberg-marquardt parameter and iteration counter. */
par = 0.;
iter = 1;
/* beginning of the outer loop. */
L30:
/* calculate the jacobian matrix. */
iflag = 2;
__minpack_func__(fdjac2)(__minpack_param_fcn_mn__ m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &
iflag, epsfcn, &wa4[1]);
*nfev += *n;
if (iflag < 0) {
goto L300;
}
/* if requested, call fcn to enable printing of iterates. */
if (*nprint <= 0) {
goto L40;
}
iflag = 0;
if ((iter - 1) % *nprint == 0) {
fcn_mn(m, n, &x[1], &fvec[1], &iflag);
}
if (iflag < 0) {
goto L300;
}
L40:
/* compute the qr factorization of the jacobian. */
__minpack_func__(qrfac)(m, n, &fjac[fjac_offset], ldfjac, &c_true, &ipvt[1], n, &wa1[1], &
wa2[1], &wa3[1]);
/* 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) {
goto L60;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
diag[j] = wa2[j];
if (wa2[j] == 0.) {
diag[j] = 1.;
}
/* L50: */
}
L60:
/* on the first iteration, calculate the norm of the scaled x */
/* and initialize the step bound delta. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa3[j] = diag[j] * x[j];
/* L70: */
}
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
delta = *factor * xnorm;
if (delta == 0.) {
delta = *factor;
}
L80:
/* form (q transpose)*fvec and store the first n components in */
/* qtf. */
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
wa4[i__] = fvec[i__];
/* L90: */
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (fjac[j + j * fjac_dim1] == 0.) {
goto L120;
}
sum = 0.;
i__2 = *m;
for (i__ = j; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * wa4[i__];
/* L100: */
}
temp = -sum / fjac[j + j * fjac_dim1];
i__2 = *m;
for (i__ = j; i__ <= i__2; ++i__) {
wa4[i__] += fjac[i__ + j * fjac_dim1] * temp;
/* L110: */
}
L120:
fjac[j + j * fjac_dim1] = wa1[j];
qtf[j] = wa4[j];
/* L130: */
}
/* compute the norm of the scaled gradient. */
gnorm = 0.;
if (fnorm == 0.) {
goto L170;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
l = ipvt[j];
if (wa2[l] == 0.) {
goto L150;
}
sum = 0.;
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * (qtf[i__] / fnorm);
/* L140: */
}
/* Computing MAX */
d__2 = gnorm, d__3 = fabs(sum / wa2[l]);
gnorm = max(d__2,d__3);
L150:
/* L160: */
;
}
L170:
/* test for convergence of the gradient norm. */
if (gnorm <= *gtol) {
*info = 4;
}
if (*info != 0) {
goto L300;
}
/* rescale if necessary. */
if (*mode == 2) {
goto L190;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
d__1 = diag[j], d__2 = wa2[j];
diag[j] = max(d__1,d__2);
/* L180: */
}
L190:
/* beginning of the inner loop. */
L200:
/* determine the levenberg-marquardt parameter. */
__minpack_func__(lmpar)(n, &fjac[fjac_offset], ldfjac, &ipvt[1], &diag[1], &qtf[1], &delta,
&par, &wa1[1], &wa2[1], &wa3[1], &wa4[1]);
/* store the direction p and x + p. calculate the norm of p. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] = -wa1[j];
wa2[j] = x[j] + wa1[j];
wa3[j] = diag[j] * wa1[j];
/* L210: */
}
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
/* 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_mn(m, n, &wa2[1], &wa4[1], &iflag);
++(*nfev);
if (iflag < 0) {
goto L300;
}
fnorm1 = __minpack_func__(enorm)(m, &wa4[1]);
/* compute the scaled actual reduction. */
actred = -1.;
if (p1 * fnorm1 < fnorm) {
/* Computing 2nd power */
d__1 = fnorm1 / fnorm;
actred = 1. - d__1 * d__1;
}
/* compute the scaled predicted reduction and */
/* the scaled directional derivative. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa3[j] = 0.;
l = ipvt[j];
temp = wa1[l];
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
wa3[i__] += fjac[i__ + j * fjac_dim1] * temp;
/* L220: */
}
/* L230: */
}
temp1 = __minpack_func__(enorm)(n, &wa3[1]) / fnorm;
temp2 = sqrt(par) * pnorm / fnorm;
/* Computing 2nd power */
d__1 = temp1;
/* Computing 2nd power */
d__2 = temp2;
prered = d__1 * d__1 + d__2 * d__2 / p5;
/* Computing 2nd power */
d__1 = temp1;
/* Computing 2nd power */
d__2 = temp2;
dirder = -(d__1 * d__1 + d__2 * d__2);
/* compute the ratio of the actual to the predicted */
/* reduction. */
ratio = 0.;
if (prered != 0.) {
ratio = actred / prered;
}
/* update the step bound. */
if (ratio > p25) {
goto L240;
}
if (actred >= 0.) {
temp = p5;
} else {
temp = p5 * dirder / (dirder + p5 * actred);
}
if (p1 * fnorm1 >= fnorm || temp < p1) {
temp = p1;
}
/* Computing MIN */
d__1 = delta, d__2 = pnorm / p1;
delta = temp * min(d__1,d__2);
par /= temp;
goto L260;
L240:
if (par != 0. && ratio < p75) {
goto L250;
}
delta = pnorm / p5;
par = p5 * par;
L250:
L260:
/* test for successful iteration. */
if (ratio < p0001) {
goto L290;
}
/* successful iteration. update x, fvec, and their norms. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
/* L270: */
}
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
fvec[i__] = wa4[i__];
/* L280: */
}
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
fnorm = fnorm1;
++iter;
L290:
/* tests for convergence. */
if (fabs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1.) {
*info = 1;
}
if (delta <= *xtol * xnorm) {
*info = 2;
}
if (fabs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1. && *info
== 2) {
*info = 3;
}
if (*info != 0) {
goto L300;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= *maxfev) {
*info = 5;
}
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * 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 < p0001) {
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_mn(m, n, &x[1], &fvec[1], &iflag);
}
return;
/* last card of subroutine lmdif. */
} /* lmdif_ */

View File

@ -1,338 +0,0 @@
/* lmpar.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
void __cminpack_func__(lmpar)(int n, real *r, int ldr,
const int *ipvt, const real *diag, const real *qtb, real delta,
real *par, real *x, real *sdiag, real *wa1,
real *wa2)
{
/* Initialized data */
#define p1 .1
#define p001 .001
/* System generated locals */
real d1, d2;
/* Local variables */
int j, l;
real fp;
real parc, parl;
int iter;
real temp, paru, dwarf;
int nsing;
real gnorm;
real dxnorm;
/* ********** */
/* 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. */
/* subprograms called */
/* minpack-supplied ... dpmpar,enorm,qrsolv */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* dwarf is the smallest positive magnitude. */
dwarf = __cminpack_func__(dpmpar)(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.;
}
}
# ifdef USE_CBLAS
cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, nsing, r, ldr, wa1, 1);
# else
if (nsing >= 1) {
int k;
for (k = 1; k <= nsing; ++k) {
j = nsing - k;
wa1[j] /= r[j + j * ldr];
temp = wa1[j];
if (j >= 1) {
int i;
for (i = 0; i < j; ++i) {
wa1[i] -= r[i + j * ldr] * temp;
}
}
}
}
# endif
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 = __cminpack_enorm__(n, wa2);
fp = dxnorm - delta;
if (fp <= p1 * delta) {
goto TERMINATE;
}
/* 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) {
for (j = 0; j < n; ++j) {
l = ipvt[j]-1;
wa1[j] = diag[l] * (wa2[l] / dxnorm);
}
# ifdef USE_CBLAS
cblas_dtrsv(CblasColMajor, CblasUpper, CblasTrans, CblasNonUnit, n, r, ldr, wa1, 1);
# else
for (j = 0; j < n; ++j) {
real sum = 0.;
if (j >= 1) {
int i;
for (i = 0; i < j; ++i) {
sum += r[i + j * ldr] * wa1[i];
}
}
wa1[j] = (wa1[j] - sum) / r[j + j * ldr];
}
# endif
temp = __cminpack_enorm__(n, wa1);
parl = fp / delta / temp / temp;
}
/* calculate an upper bound, paru, for the zero of the function. */
for (j = 0; j < n; ++j) {
real sum;
# ifdef USE_CBLAS
sum = cblas_ddot(j+1, &r[j*ldr], 1, qtb, 1);
# else
int i;
sum = 0.;
for (i = 0; i <= j; ++i) {
sum += r[i + j * ldr] * qtb[i];
}
# endif
l = ipvt[j]-1;
wa1[j] = sum / diag[l];
}
gnorm = __cminpack_enorm__(n, wa1);
paru = gnorm / delta;
if (paru == 0.) {
paru = dwarf / min(delta,(real)p1) /* / p001 ??? */;
}
/* 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. */
for (;;) {
++iter;
/* evaluate the function at the current value of par. */
if (*par == 0.) {
/* Computing MAX */
d1 = dwarf, d2 = p001 * paru;
*par = max(d1,d2);
}
temp = sqrt(*par);
for (j = 0; j < n; ++j) {
wa1[j] = temp * diag[j];
}
__cminpack_func__(qrsolv)(n, r, ldr, ipvt, wa1, qtb, x, sdiag, wa2);
for (j = 0; j < n; ++j) {
wa2[j] = diag[j] * x[j];
}
dxnorm = __cminpack_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 (fabs(fp) <= p1 * delta || (parl == 0. && fp <= temp && temp < 0.) || iter == 10) {
goto TERMINATE;
}
/* compute the newton correction. */
# ifdef USE_CBLAS
for (j = 0; j < nsing; ++j) {
l = ipvt[j]-1;
wa1[j] = diag[l] * (wa2[l] / dxnorm);
}
for (j = nsing; j < n; ++j) {
wa1[j] = 0.;
}
/* exchange the diagonal of r with sdiag */
cblas_dswap(n, r, ldr+1, sdiag, 1);
/* solve lower(r).x = wa1, result id put in wa1 */
cblas_dtrsv(CblasColMajor, CblasLower, CblasNoTrans, CblasNonUnit, nsing, r, ldr, wa1, 1);
/* exchange the diagonal of r with sdiag */
cblas_dswap( n, r, ldr+1, sdiag, 1);
# else /* !USE_CBLAS */
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) {
int i;
for (i = j+1; i < n; ++i) {
wa1[i] -= r[i + j * ldr] * temp;
}
}
}
# endif /* !USE_CBLAS */
temp = __cminpack_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. */
/* Computing MAX */
d1 = parl, d2 = *par + parc;
*par = max(d1,d2);
/* end of an iteration. */
}
TERMINATE:
/* termination. */
if (iter == 0) {
*par = 0.;
}
/* last card of subroutine lmpar. */
} /* lmpar_ */

View File

@ -1,372 +0,0 @@
/* lmpar.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(lmpar)(const int *n, real *r__, const int *ldr,
const int *ipvt, const real *diag, const real *qtb, const real *delta,
real *par, real *x, real *sdiag, real *wa1,
real *wa2)
{
/* Table of constant values */
const int c__2 = 2;
/* Initialized data */
#define p1 .1
#define p001 .001
/* System generated locals */
int r_dim1, r_offset, i__1, i__2;
real d__1, d__2;
/* Local variables */
int i__, j, k, l;
real fp;
int jm1, jp1;
real sum, parc, parl;
int iter;
real temp, paru, dwarf;
int nsing;
real gnorm;
real dxnorm;
/* ********** */
/* 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. */
/* subprograms called */
/* minpack-supplied ... dpmpar,enorm,qrsolv */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa2;
--wa1;
--sdiag;
--x;
--qtb;
--diag;
--ipvt;
r_dim1 = *ldr;
r_offset = 1 + r_dim1 * 1;
r__ -= r_offset;
/* Function Body */
/* dwarf is the smallest positive magnitude. */
dwarf = __minpack_func__(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;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] = qtb[j];
if (r__[j + j * r_dim1] == 0. && nsing == *n) {
nsing = j - 1;
}
if (nsing < *n) {
wa1[j] = 0.;
}
/* L10: */
}
if (nsing < 1) {
goto L50;
}
i__1 = nsing;
for (k = 1; k <= i__1; ++k) {
j = nsing - k + 1;
wa1[j] /= r__[j + j * r_dim1];
temp = wa1[j];
jm1 = j - 1;
if (jm1 < 1) {
goto L30;
}
i__2 = jm1;
for (i__ = 1; i__ <= i__2; ++i__) {
wa1[i__] -= r__[i__ + j * r_dim1] * temp;
/* L20: */
}
L30:
/* L40: */
;
}
L50:
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
l = ipvt[j];
x[l] = wa1[j];
/* L60: */
}
/* initialize the iteration counter. */
/* evaluate the function at the origin, and test */
/* for acceptance of the gauss-newton direction. */
iter = 0;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa2[j] = diag[j] * x[j];
/* L70: */
}
dxnorm = __minpack_func__(enorm)(n, &wa2[1]);
fp = dxnorm - *delta;
if (fp <= p1 * *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;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
l = ipvt[j];
wa1[j] = diag[l] * (wa2[l] / dxnorm);
/* L80: */
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
sum = 0.;
jm1 = j - 1;
if (jm1 < 1) {
goto L100;
}
i__2 = jm1;
for (i__ = 1; i__ <= i__2; ++i__) {
sum += r__[i__ + j * r_dim1] * wa1[i__];
/* L90: */
}
L100:
wa1[j] = (wa1[j] - sum) / r__[j + j * r_dim1];
/* L110: */
}
temp = __minpack_func__(enorm)(n, &wa1[1]);
parl = fp / *delta / temp / temp;
L120:
/* calculate an upper bound, paru, for the zero of the function. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
sum = 0.;
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
sum += r__[i__ + j * r_dim1] * qtb[i__];
/* L130: */
}
l = ipvt[j];
wa1[j] = sum / diag[l];
/* L140: */
}
gnorm = __minpack_func__(enorm)(n, &wa1[1]);
paru = gnorm / *delta;
if (paru == 0.) {
paru = dwarf / min(*delta,(real)p1);
}
/* 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.) {
/* Computing MAX */
d__1 = dwarf, d__2 = p001 * paru;
*par = max(d__1,d__2);
}
temp = sqrt(*par);
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] = temp * diag[j];
/* L160: */
}
__minpack_func__(qrsolv)(n, &r__[r_offset], ldr, &ipvt[1], &wa1[1], &qtb[1], &x[1], &sdiag[
1], &wa2[1]);
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa2[j] = diag[j] * x[j];
/* L170: */
}
dxnorm = __minpack_func__(enorm)(n, &wa2[1]);
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) <= p1 * *delta || (parl == 0. && fp <= temp && temp < 0.) ||
iter == 10) {
goto L220;
}
/* compute the newton correction. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
l = ipvt[j];
wa1[j] = diag[l] * (wa2[l] / dxnorm);
/* L180: */
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] /= sdiag[j];
temp = wa1[j];
jp1 = j + 1;
if (*n < jp1) {
goto L200;
}
i__2 = *n;
for (i__ = jp1; i__ <= i__2; ++i__) {
wa1[i__] -= r__[i__ + j * r_dim1] * temp;
/* L190: */
}
L200:
/* L210: */
;
}
temp = __minpack_func__(enorm)(n, &wa1[1]);
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. */
/* Computing MAX */
d__1 = parl, d__2 = *par + parc;
*par = max(d__1,d__2);
/* end of an iteration. */
goto L150;
L220:
/* termination. */
if (iter == 0) {
*par = 0.;
}
return;
/* last card of subroutine lmpar. */
} /* lmpar_ */

View File

@ -1,544 +0,0 @@
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(lmstr)(__cminpack_decl_fcnderstr_mn__ void *p, int m, int n, real *x,
real *fvec, real *fjac, int ldfjac, real ftol,
real xtol, real gtol, int maxfev, real *
diag, int mode, real factor, int nprint,
int *nfev, int *njev, int *ipvt, real *qtf,
real *wa1, real *wa2, real *wa3, real *wa4)
{
/* Initialized data */
#define p1 .1
#define p5 .5
#define p25 .25
#define p75 .75
#define p0001 1e-4
/* System generated locals */
real d1, d2;
/* Local variables */
int i, j, l;
real par, sum;
int sing;
int iter;
real temp, temp1, temp2;
int iflag;
real delta = 0.;
real ratio;
real fnorm, gnorm, pnorm, xnorm = 0., fnorm1, actred, dirder,
epsmch, prered;
int info;
/* ********** */
/* subroutine lmstr */
/* the purpose of lmstr is to minimize the sum of the squares of */
/* m nonlinear functions in n variables by a modification of */
/* the levenberg-marquardt algorithm which uses minimal storage. */
/* the user must provide a subroutine which calculates the */
/* functions and the rows of the jacobian. */
/* the subroutine statement is */
/* subroutine lmstr(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 rows of 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,fjrow,iflag) */
/* integer m,n,iflag */
/* double precision x(n),fvec(m),fjrow(n) */
/* ---------- */
/* if iflag = 1 calculate the functions at x and */
/* return this vector in fvec. */
/* if iflag = i calculate the (i-1)-st row of the */
/* jacobian at x and return this vector in fjrow. */
/* ---------- */
/* return */
/* end */
/* the value of iflag should not be changed by fcn unless */
/* the user wants to terminate execution of lmstr. */
/* 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 n by n array. the upper triangle of fjac */
/* contains an upper triangular matrix r 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 triangular */
/* part of fjac contains information generated during */
/* the computation of r. */
/* ldfjac is a positive integer input variable not less than n */
/* 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 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 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. */
/* 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. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dpmpar,enorm,lmpar,qrfac,rwupdt */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
/* jorge j. more */
/* ********** */
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(1);
info = 0;
iflag = 0;
*nfev = 0;
*njev = 0;
/* check the input parameters for errors. */
if (n <= 0 || m < n || ldfjac < n || ftol < 0. || xtol < 0. ||
gtol < 0. || maxfev <= 0 || factor <= 0.) {
goto TERMINATE;
}
if (mode == 2) {
for (j = 0; j < n; ++j) {
if (diag[j] <= 0.) {
goto TERMINATE;
}
}
}
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = fcnderstr_mn(p, m, n, x, fvec, wa3, 1);
*nfev = 1;
if (iflag < 0) {
goto TERMINATE;
}
fnorm = __cminpack_enorm__(m, fvec);
/* initialize levenberg-marquardt parameter and iteration counter. */
par = 0.;
iter = 1;
/* beginning of the outer loop. */
for (;;) {
/* if requested, call fcn to enable printing of iterates. */
if (nprint > 0) {
iflag = 0;
if ((iter - 1) % nprint == 0) {
iflag = fcnderstr_mn(p, m, n, x, fvec, wa3, 0);
}
if (iflag < 0) {
goto TERMINATE;
}
}
/* compute the qr factorization of the jacobian matrix */
/* calculated one row at a time, while simultaneously */
/* forming (q transpose)*fvec and storing the first */
/* n components in qtf. */
for (j = 0; j < n; ++j) {
qtf[j] = 0.;
for (i = 0; i < n; ++i) {
fjac[i + j * ldfjac] = 0.;
}
}
iflag = 2;
for (i = 0; i < m; ++i) {
if (fcnderstr_mn(p, m, n, x, fvec, wa3, iflag) < 0) {
goto TERMINATE;
}
temp = fvec[i];
__cminpack_func__(rwupdt)(n, fjac, ldfjac, wa3, qtf, &temp,
wa1, wa2);
++iflag;
}
++(*njev);
/* if the jacobian is rank deficient, call qrfac to */
/* reorder its columns and update the components of qtf. */
sing = FALSE_;
for (j = 0; j < n; ++j) {
if (fjac[j + j * ldfjac] == 0.) {
sing = TRUE_;
}
ipvt[j] = j+1;
wa2[j] = __cminpack_enorm__(j+1, &fjac[j * ldfjac + 0]);
}
if (sing) {
__cminpack_func__(qrfac)(n, n, fjac, ldfjac, TRUE_, ipvt, n,
wa1, wa2, wa3);
for (j = 0; j < n; ++j) {
if (fjac[j + j * ldfjac] != 0.) {
sum = 0.;
for (i = j; i < n; ++i) {
sum += fjac[i + j * ldfjac] * qtf[i];
}
temp = -sum / fjac[j + j * ldfjac];
for (i = j; i < n; ++i) {
qtf[i] += fjac[i + j * ldfjac] * temp;
}
}
fjac[j + j * ldfjac] = wa1[j];
}
}
/* on the first iteration and if mode is 1, scale according */
/* to the norms of the columns of the initial jacobian. */
if (iter == 1) {
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 = __cminpack_enorm__(n, wa3);
delta = factor * xnorm;
if (delta == 0.) {
delta = factor;
}
}
/* 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.) {
sum = 0.;
for (i = 0; i <= j; ++i) {
sum += fjac[i + j * ldfjac] * (qtf[i] / fnorm);
}
/* Computing MAX */
d1 = fabs(sum / wa2[l]);
gnorm = max(gnorm,d1);
}
}
}
/* test for convergence of the gradient norm. */
if (gnorm <= gtol) {
info = 4;
}
if (info != 0) {
goto TERMINATE;
}
/* rescale if necessary. */
if (mode != 2) {
for (j = 0; j < n; ++j) {
/* Computing MAX */
d1 = diag[j], d2 = wa2[j];
diag[j] = max(d1,d2);
}
}
/* beginning of the inner loop. */
do {
/* determine the levenberg-marquardt parameter. */
__cminpack_func__(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 = __cminpack_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 = fcnderstr_mn(p, m, n, wa2, wa4, wa3, 1);
++(*nfev);
if (iflag < 0) {
goto TERMINATE;
}
fnorm1 = __cminpack_enorm__(m, wa4);
/* compute the scaled actual reduction. */
actred = -1.;
if (p1 * fnorm1 < fnorm) {
/* Computing 2nd power */
d1 = fnorm1 / fnorm;
actred = 1. - d1 * d1;
}
/* 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 = __cminpack_enorm__(n, wa3) / fnorm;
temp2 = (sqrt(par) * pnorm) / fnorm;
prered = temp1 * temp1 + temp2 * temp2 / p5;
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 <= p25) {
if (actred >= 0.) {
temp = p5;
} else {
temp = p5 * dirder / (dirder + p5 * actred);
}
if (p1 * fnorm1 >= fnorm || temp < p1) {
temp = p1;
}
/* Computing MIN */
d1 = pnorm / p1;
delta = temp * min(delta,d1);
par /= temp;
} else {
if (par == 0. || ratio >= p75) {
delta = pnorm / p5;
par = p5 * par;
}
}
/* test for successful iteration. */
if (ratio >= p0001) {
/* 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 = __cminpack_enorm__(n, wa2);
fnorm = fnorm1;
++iter;
}
/* tests for convergence. */
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1.) {
info = 1;
}
if (delta <= xtol * xnorm) {
info = 2;
}
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1. && info == 2) {
info = 3;
}
if (info != 0) {
goto TERMINATE;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= maxfev) {
info = 5;
}
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
info = 6;
}
if (delta <= epsmch * xnorm) {
info = 7;
}
if (gnorm <= epsmch) {
info = 8;
}
if (info != 0) {
goto TERMINATE;
}
/* end of the inner loop. repeat if iteration unsuccessful. */
} while (ratio < p0001);
/* end of the outer loop. */
}
TERMINATE:
/* termination, either normal or user imposed. */
if (iflag < 0) {
info = iflag;
}
if (nprint > 0) {
fcnderstr_mn(p, m, n, x, fvec, wa3, 0);
}
return info;
/* last card of subroutine lmstr. */
} /* lmstr_ */

View File

@ -1,167 +0,0 @@
#include "cminpack.h"
#include "cminpackP.h"
__cminpack_attr__
int __cminpack_func__(lmstr1)(__cminpack_decl_fcnderstr_mn__ void *p, int m, int n, real *x,
real *fvec, real *fjac, int ldfjac, real tol,
int *ipvt, real *wa, int lwa)
{
/* Initialized data */
const real factor = 100.;
/* Local variables */
int mode, nfev, njev;
real ftol, gtol, xtol;
int maxfev, nprint;
int info;
/* ********** */
/* subroutine lmstr1 */
/* the purpose of lmstr1 is to minimize the sum of the squares of */
/* m nonlinear functions in n variables by a modification of */
/* the levenberg-marquardt algorithm which uses minimal storage. */
/* this is done by using the more general least-squares solver */
/* lmstr. the user must provide a subroutine which calculates */
/* the functions and the rows of the jacobian. */
/* the subroutine statement is */
/* subroutine lmstr1(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 rows of 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,fjrow,iflag) */
/* integer m,n,iflag */
/* double precision x(n),fvec(m),fjrow(n) */
/* ---------- */
/* if iflag = 1 calculate the functions at x and */
/* return this vector in fvec. */
/* if iflag = i calculate the (i-1)-st row of the */
/* jacobian at x and return this vector in fjrow. */
/* ---------- */
/* return */
/* end */
/* the value of iflag should not be changed by fcn unless */
/* the user wants to terminate execution of lmstr1. */
/* 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 n by n array. the upper triangle of fjac */
/* contains an upper triangular matrix r 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 triangular */
/* part of fjac contains information generated during */
/* the computation of r. */
/* ldfjac is a positive integer input variable not less than n */
/* 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. */
/* 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 ... lmstr */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
/* jorge j. more */
/* ********** */
/* check the input parameters for errors. */
if (n <= 0 || m < n || ldfjac < n || tol < 0. || lwa < n * 5 + m) {
return 0;
}
/* call lmstr. */
maxfev = (n + 1) * 100;
ftol = tol;
xtol = tol;
gtol = 0.;
mode = 1;
nprint = 0;
info = __cminpack_func__(lmstr)(__cminpack_param_fcnderstr_mn__ p, m, n, x, fvec, fjac, ldfjac,
ftol, xtol, gtol, maxfev, wa, mode, factor, nprint,
&nfev, &njev, ipvt, &wa[n], &wa[(n << 1)], &
wa[n * 3], &wa[(n << 2)], &wa[n * 5]);
if (info == 8) {
info = 4;
}
return info;
/* last card of subroutine lmstr1. */
} /* lmstr1_ */

View File

@ -1,190 +0,0 @@
/* lmstr1.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(lmstr1)(__minpack_decl_fcnderstr_mn__ const int *m, const int *n, real *x,
real *fvec, real *fjac, const int *ldfjac, const real *tol,
int *info, int *ipvt, real *wa, const int *lwa)
{
/* Initialized data */
const real factor = 100.;
/* System generated locals */
int fjac_dim1, fjac_offset;
/* Local variables */
int mode, nfev, njev;
real ftol, gtol, xtol;
int maxfev, nprint;
/* ********** */
/* subroutine lmstr1 */
/* the purpose of lmstr1 is to minimize the sum of the squares of */
/* m nonlinear functions in n variables by a modification of */
/* the levenberg-marquardt algorithm which uses minimal storage. */
/* this is done by using the more general least-squares solver */
/* lmstr. the user must provide a subroutine which calculates */
/* the functions and the rows of the jacobian. */
/* the subroutine statement is */
/* subroutine lmstr1(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 rows of 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,fjrow,iflag) */
/* integer m,n,iflag */
/* double precision x(n),fvec(m),fjrow(n) */
/* ---------- */
/* if iflag = 1 calculate the functions at x and */
/* return this vector in fvec. */
/* if iflag = i calculate the (i-1)-st row of the */
/* jacobian at x and return this vector in fjrow. */
/* ---------- */
/* return */
/* end */
/* the value of iflag should not be changed by fcn unless */
/* the user wants to terminate execution of lmstr1. */
/* 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 n by n array. the upper triangle of fjac */
/* contains an upper triangular matrix r 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 triangular */
/* part of fjac contains information generated during */
/* the computation of r. */
/* ldfjac is a positive integer input variable not less than n */
/* 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. */
/* 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 ... lmstr */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
/* jorge j. more */
/* ********** */
/* Parameter adjustments */
--fvec;
--ipvt;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
--wa;
/* Function Body */
*info = 0;
/* check the input parameters for errors. */
if (*n <= 0 || *m < *n || *ldfjac < *n || *tol < 0. || *lwa < *n * 5 + *
m) {
/* goto L10; */
return;
}
/* call lmstr. */
maxfev = (*n + 1) * 100;
ftol = *tol;
xtol = *tol;
gtol = 0.;
mode = 1;
nprint = 0;
__minpack_func__(lmstr)(__minpack_param_fcnderstr_mn__ m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &
ftol, &xtol, &gtol, &maxfev, &wa[1], &mode, &factor, &nprint,
info, &nfev, &njev, &ipvt[1], &wa[*n + 1], &wa[(*n << 1) + 1], &
wa[*n * 3 + 1], &wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
if (*info == 8) {
*info = 4;
}
/* L10: */
return;
/* last card of subroutine lmstr1. */
} /* lmstr1_ */

View File

@ -1,648 +0,0 @@
/* lmstr.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(lmstr)(__minpack_decl_fcnderstr_mn__ const int *m, const int *n, real *x,
real *fvec, real *fjac, const int *ldfjac, const real *ftol,
const real *xtol, const real *gtol, const int *maxfev, real *
diag, const int *mode, const real *factor, const int *nprint, int *
info, int *nfev, int *njev, int *ipvt, real *qtf,
real *wa1, real *wa2, real *wa3, real *wa4)
{
/* Table of constant values */
const int c__1 = 1;
const int c_true = TRUE_;
/* Initialized data */
#define p1 .1
#define p5 .5
#define p25 .25
#define p75 .75
#define p0001 1e-4
/* System generated locals */
int fjac_dim1, fjac_offset, i__1, i__2;
real d__1, d__2, d__3;
/* Local variables */
int i__, j, l;
real par, sum;
int sing;
int iter;
real temp, temp1, temp2;
int iflag;
real delta;
real ratio;
real fnorm, gnorm, pnorm, xnorm = 0, fnorm1, actred, dirder,
epsmch, prered;
/* ********** */
/* subroutine lmstr */
/* the purpose of lmstr is to minimize the sum of the squares of */
/* m nonlinear functions in n variables by a modification of */
/* the levenberg-marquardt algorithm which uses minimal storage. */
/* the user must provide a subroutine which calculates the */
/* functions and the rows of the jacobian. */
/* the subroutine statement is */
/* subroutine lmstr(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 rows of 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,fjrow,iflag) */
/* integer m,n,iflag */
/* double precision x(n),fvec(m),fjrow(n) */
/* ---------- */
/* if iflag = 1 calculate the functions at x and */
/* return this vector in fvec. */
/* if iflag = i calculate the (i-1)-st row of the */
/* jacobian at x and return this vector in fjrow. */
/* ---------- */
/* return */
/* end */
/* the value of iflag should not be changed by fcn unless */
/* the user wants to terminate execution of lmstr. */
/* 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 n by n array. the upper triangle of fjac */
/* contains an upper triangular matrix r 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 triangular */
/* part of fjac contains information generated during */
/* the computation of r. */
/* ldfjac is a positive integer input variable not less than n */
/* 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 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 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. */
/* 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. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... dpmpar,enorm,lmpar,qrfac,rwupdt */
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
/* jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa4;
--fvec;
--wa3;
--wa2;
--wa1;
--qtf;
--ipvt;
--diag;
--x;
fjac_dim1 = *ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(dpmpar)(&c__1);
*info = 0;
iflag = 0;
*nfev = 0;
*njev = 0;
/* check the input parameters for errors. */
if (*n <= 0 || *m < *n || *ldfjac < *n || *ftol < 0. || *xtol < 0. ||
*gtol < 0. || *maxfev <= 0 || *factor <= 0.) {
goto L340;
}
if (*mode != 2) {
goto L20;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (diag[j] <= 0.) {
goto L340;
}
/* L10: */
}
L20:
/* evaluate the function at the starting point */
/* and calculate its norm. */
iflag = 1;
fcnderstr_mn(m, n, &x[1], &fvec[1], &wa3[1], &iflag);
*nfev = 1;
if (iflag < 0) {
goto L340;
}
fnorm = __minpack_func__(enorm)(m, &fvec[1]);
/* initialize levenberg-marquardt parameter and iteration counter. */
par = 0.;
iter = 1;
/* beginning of the outer loop. */
L30:
/* if requested, call fcn to enable printing of iterates. */
if (*nprint <= 0) {
goto L40;
}
iflag = 0;
if ((iter - 1) % *nprint == 0) {
fcnderstr_mn(m, n, &x[1], &fvec[1], &wa3[1], &iflag);
}
if (iflag < 0) {
goto L340;
}
L40:
/* compute the qr factorization of the jacobian matrix */
/* calculated one row at a time, while simultaneously */
/* forming (q transpose)*fvec and storing the first */
/* n components in qtf. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
qtf[j] = 0.;
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
fjac[i__ + j * fjac_dim1] = 0.;
/* L50: */
}
/* L60: */
}
iflag = 2;
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
fcnderstr_mn(m, n, &x[1], &fvec[1], &wa3[1], &iflag);
if (iflag < 0) {
goto L340;
}
temp = fvec[i__];
__minpack_func__(rwupdt)(n, &fjac[fjac_offset], ldfjac, &wa3[1], &qtf[1], &temp, &wa1[
1], &wa2[1]);
++iflag;
/* L70: */
}
++(*njev);
/* if the jacobian is rank deficient, call qrfac to */
/* reorder its columns and update the components of qtf. */
sing = FALSE_;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (fjac[j + j * fjac_dim1] == 0.) {
sing = TRUE_;
}
ipvt[j] = j;
wa2[j] = __minpack_func__(enorm)(&j, &fjac[j * fjac_dim1 + 1]);
/* L80: */
}
if (! sing) {
goto L130;
}
__minpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, &c_true, &ipvt[1], n, &wa1[1], &
wa2[1], &wa3[1]);
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (fjac[j + j * fjac_dim1] == 0.) {
goto L110;
}
sum = 0.;
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * qtf[i__];
/* L90: */
}
temp = -sum / fjac[j + j * fjac_dim1];
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
qtf[i__] += fjac[i__ + j * fjac_dim1] * temp;
/* L100: */
}
L110:
fjac[j + j * fjac_dim1] = wa1[j];
/* L120: */
}
L130:
/* 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 L170;
}
if (*mode == 2) {
goto L150;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
diag[j] = wa2[j];
if (wa2[j] == 0.) {
diag[j] = 1.;
}
/* L140: */
}
L150:
/* on the first iteration, calculate the norm of the scaled x */
/* and initialize the step bound delta. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa3[j] = diag[j] * x[j];
/* L160: */
}
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
delta = *factor * xnorm;
if (delta == 0.) {
delta = *factor;
}
L170:
/* compute the norm of the scaled gradient. */
gnorm = 0.;
if (fnorm == 0.) {
goto L210;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
l = ipvt[j];
if (wa2[l] == 0.) {
goto L190;
}
sum = 0.;
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
sum += fjac[i__ + j * fjac_dim1] * (qtf[i__] / fnorm);
/* L180: */
}
/* Computing MAX */
d__2 = gnorm, d__3 = (d__1 = sum / wa2[l], abs(d__1));
gnorm = max(d__2,d__3);
L190:
/* L200: */
;
}
L210:
/* test for convergence of the gradient norm. */
if (gnorm <= *gtol) {
*info = 4;
}
if (*info != 0) {
goto L340;
}
/* rescale if necessary. */
if (*mode == 2) {
goto L230;
}
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
d__1 = diag[j], d__2 = wa2[j];
diag[j] = max(d__1,d__2);
/* L220: */
}
L230:
/* beginning of the inner loop. */
L240:
/* determine the levenberg-marquardt parameter. */
__minpack_func__(lmpar)(n, &fjac[fjac_offset], ldfjac, &ipvt[1], &diag[1], &qtf[1], &delta,
&par, &wa1[1], &wa2[1], &wa3[1], &wa4[1]);
/* store the direction p and x + p. calculate the norm of p. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa1[j] = -wa1[j];
wa2[j] = x[j] + wa1[j];
wa3[j] = diag[j] * wa1[j];
/* L250: */
}
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
/* 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;
fcnderstr_mn(m, n, &wa2[1], &wa4[1], &wa3[1], &iflag);
++(*nfev);
if (iflag < 0) {
goto L340;
}
fnorm1 = __minpack_func__(enorm)(m, &wa4[1]);
/* compute the scaled actual reduction. */
actred = -1.;
if (p1 * fnorm1 < fnorm) {
/* Computing 2nd power */
d__1 = fnorm1 / fnorm;
actred = 1. - d__1 * d__1;
}
/* compute the scaled predicted reduction and */
/* the scaled directional derivative. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
wa3[j] = 0.;
l = ipvt[j];
temp = wa1[l];
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
wa3[i__] += fjac[i__ + j * fjac_dim1] * temp;
/* L260: */
}
/* L270: */
}
temp1 = __minpack_func__(enorm)(n, &wa3[1]) / fnorm;
temp2 = sqrt(par) * pnorm / fnorm;
/* Computing 2nd power */
d__1 = temp1;
/* Computing 2nd power */
d__2 = temp2;
prered = d__1 * d__1 + d__2 * d__2 / p5;
/* Computing 2nd power */
d__1 = temp1;
/* Computing 2nd power */
d__2 = temp2;
dirder = -(d__1 * d__1 + d__2 * d__2);
/* compute the ratio of the actual to the predicted */
/* reduction. */
ratio = 0.;
if (prered != 0.) {
ratio = actred / prered;
}
/* update the step bound. */
if (ratio > p25) {
goto L280;
}
if (actred >= 0.) {
temp = p5;
}
if (actred < 0.) {
temp = p5 * dirder / (dirder + p5 * actred);
}
if (p1 * fnorm1 >= fnorm || temp < p1) {
temp = p1;
}
/* Computing MIN */
d__1 = delta, d__2 = pnorm / p1;
delta = temp * min(d__1,d__2);
par /= temp;
goto L300;
L280:
if (par != 0. && ratio < p75) {
goto L290;
}
delta = pnorm / p5;
par = p5 * par;
L290:
L300:
/* test for successful iteration. */
if (ratio < p0001) {
goto L330;
}
/* successful iteration. update x, fvec, and their norms. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
/* L310: */
}
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
fvec[i__] = wa4[i__];
/* L320: */
}
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
fnorm = fnorm1;
++iter;
L330:
/* tests for convergence. */
if (abs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1.) {
*info = 1;
}
if (delta <= *xtol * xnorm) {
*info = 2;
}
if (abs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1. && *info
== 2) {
*info = 3;
}
if (*info != 0) {
goto L340;
}
/* tests for termination and stringent tolerances. */
if (*nfev >= *maxfev) {
*info = 5;
}
if (abs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
*info = 6;
}
if (delta <= epsmch * xnorm) {
*info = 7;
}
if (gnorm <= epsmch) {
*info = 8;
}
if (*info != 0) {
goto L340;
}
/* end of the inner loop. repeat if iteration unsuccessful. */
if (ratio < p0001) {
goto L240;
}
/* end of the outer loop. */
goto L30;
L340:
/* termination, either normal or user imposed. */
if (iflag < 0) {
*info = iflag;
}
iflag = 0;
if (*nprint > 0) {
fcnderstr_mn(m, n, &x[1], &fvec[1], &wa3[1], &iflag);
}
return;
/* last card of subroutine lmstr. */
} /* lmstr_ */

View File

@ -1,306 +0,0 @@
#ifndef __MINPACK_H__
#define __MINPACK_H__
#include "cminpack.h"
/* The default floating-point type is "double" for C/C++ and "float" for CUDA,
but you can change this by defining one of the following symbols when
compiling the library, and before including cminpack.h when using it:
__cminpack_long_double__ for long double (requires compiler support)
__cminpack_double__ for double
__cminpack_float__ for float
__cminpack_half__ for half from the OpenEXR library (in this case, you must
compile cminpack with a C++ compiler)
*/
#ifdef __cminpack_double__
#define __minpack_func__(func) func ## _
#endif
#ifdef __cminpack_long_double__
#define __minpack_func__(func) ld ## func ## _
#endif
#ifdef __cminpack_float__
#define __minpack_func__(func) s ## func ## _
#endif
#ifdef __cminpack_half__
#define __minpack_func__(func) h ## func ## _
#endif
#ifdef __cplusplus
extern "C" {
#endif /* __cplusplus */
#define MINPACK_EXPORT CMINPACK_EXPORT
#define __minpack_real__ __cminpack_real__
#define __minpack_attr__ __cminpack_attr__
#if defined(__CUDA_ARCH__) || defined(__CUDACC__)
#define __minpack_type_fcn_nn__ __minpack_attr__ void fcn_nn
#define __minpack_type_fcnder_nn__ __minpack_attr__ void fcnder_nn
#define __minpack_type_fcn_mn__ __minpack_attr__ void fcn_mn
#define __minpack_type_fcnder_mn__ __minpack_attr__ void fcnder_mn
#define __minpack_type_fcnderstr_mn__ __minpack_attr__ void fcnderstr_mn
#define __minpack_decl_fcn_nn__
#define __minpack_decl_fcnder_nn__
#define __minpack_decl_fcn_mn__
#define __minpack_decl_fcnder_mn__
#define __minpack_decl_fcnderstr_mn__
#define __minpack_param_fcn_nn__
#define __minpack_param_fcnder_nn__
#define __minpack_param_fcn_mn__
#define __minpack_param_fcnder_mn__
#define __minpack_param_fcnderstr_mn__
#else
#define __minpack_type_fcn_nn__ typedef void (*minpack_func_nn)
#define __minpack_type_fcnder_nn__ typedef void (*minpack_funcder_nn)
#define __minpack_type_fcn_mn__ typedef void (*minpack_func_mn)
#define __minpack_type_fcnder_mn__ typedef void (*minpack_funcder_mn)
#define __minpack_type_fcnderstr_mn__ typedef void (*minpack_funcderstr_mn)
#define __minpack_decl_fcn_nn__ minpack_func_nn fcn_nn,
#define __minpack_decl_fcnder_nn__ minpack_funcder_nn fcnder_nn,
#define __minpack_decl_fcn_mn__ minpack_func_mn fcn_mn,
#define __minpack_decl_fcnder_mn__ minpack_funcder_mn fcnder_mn,
#define __minpack_decl_fcnderstr_mn__ minpack_funcderstr_mn fcnderstr_mn,
#define __minpack_param_fcn_nn__ fcn_nn,
#define __minpack_param_fcnder_nn__ fcnder_nn,
#define __minpack_param_fcn_mn__ fcn_mn,
#define __minpack_param_fcnder_mn__ fcnder_mn,
#define __minpack_param_fcnderstr_mn__ fcnderstr_mn,
#endif
#undef __cminpack_type_fcn_nn__
#undef __cminpack_type_fcnder_nn__
#undef __cminpack_type_fcn_mn__
#undef __cminpack_type_fcnder_mn__
#undef __cminpack_type_fcnderstr_mn__
#undef __cminpack_decl_fcn_nn__
#undef __cminpack_decl_fcnder_nn__
#undef __cminpack_decl_fcn_mn__
#undef __cminpack_decl_fcnder_mn__
#undef __cminpack_decl_fcnderstr_mn__
#undef __cminpack_param_fcn_nn__
#undef __cminpack_param_fcnder_nn__
#undef __cminpack_param_fcn_mn__
#undef __cminpack_param_fcnder_mn__
#undef __cminpack_param_fcnderstr_mn__
/* Declarations for minpack */
/* Function types: */
/* the iflag parameter is input-only (with respect to the FORTRAN */
/* version), the output iflag value is the return value of the function. */
/* If iflag=0, the function shoulkd just print the current values (see */
/* the nprint parameters below). */
/* for hybrd1 and hybrd: */
/* calculate the functions at x and */
/* return this vector in fvec. */
/* return a negative value to terminate hybrd1/hybrd */
__minpack_type_fcn_nn__(const int *n, const __minpack_real__ *x, __minpack_real__ *fvec, int *iflag );
/* for hybrj1 and hybrj */
/* 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 a negative value to terminate hybrj1/hybrj */
__minpack_type_fcnder_nn__(const int *n, const __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac,
const int *ldfjac, int *iflag );
/* for lmdif1 and lmdif */
/* calculate the functions at x and */
/* return this vector in fvec. */
/* if iflag = 1 the result is used to compute the residuals. */
/* if iflag = 2 the result is used to compute the Jacobian by finite differences. */
/* Jacobian computation requires exactly n function calls with iflag = 2. */
/* return a negative value to terminate lmdif1/lmdif */
__minpack_type_fcn_mn__(const int *m, const int *n, const __minpack_real__ *x, __minpack_real__ *fvec,
int *iflag );
/* for lmder1 and lmder */
/* 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 a negative value to terminate lmder1/lmder */
__minpack_type_fcnder_mn__(const int *m, const int *n, const __minpack_real__ *x, __minpack_real__ *fvec,
__minpack_real__ *fjac, const int *ldfjac, int *iflag );
/* for lmstr1 and lmstr */
/* if iflag = 1 calculate the functions at x and */
/* return this vector in fvec. */
/* if iflag = i calculate the (i-1)-st row of the */
/* jacobian at x and return this vector in fjrow. */
/* return a negative value to terminate lmstr1/lmstr */
__minpack_type_fcnderstr_mn__(const int *m, const int *n, const __minpack_real__ *x, __minpack_real__ *fvec,
__minpack_real__ *fjrow, int *iflag );
/* find a zero of a system of N nonlinear functions in N variables by
a modification of the Powell hybrid method (Jacobian calculated by
a forward-difference approximation) */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(hybrd1)( __minpack_decl_fcn_nn__
const int *n, __minpack_real__ *x, __minpack_real__ *fvec, const __minpack_real__ *tol, int *info,
__minpack_real__ *wa, const int *lwa );
/* find a zero of a system of N nonlinear functions in N variables by
a modification of the Powell hybrid method (Jacobian calculated by
a forward-difference approximation, more general). */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(hybrd)( __minpack_decl_fcn_nn__
const int *n, __minpack_real__ *x, __minpack_real__ *fvec, const __minpack_real__ *xtol, const int *maxfev,
const int *ml, const int *mu, const __minpack_real__ *epsfcn, __minpack_real__ *diag, const int *mode,
const __minpack_real__ *factor, const int *nprint, int *info, int *nfev,
__minpack_real__ *fjac, const int *ldfjac, __minpack_real__ *r, const int *lr, __minpack_real__ *qtf,
__minpack_real__ *wa1, __minpack_real__ *wa2, __minpack_real__ *wa3, __minpack_real__ *wa4);
/* find a zero of a system of N nonlinear functions in N variables by
a modification of the Powell hybrid method (user-supplied Jacobian) */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(hybrj1)( __minpack_decl_fcnder_nn__ const int *n, __minpack_real__ *x,
__minpack_real__ *fvec, __minpack_real__ *fjec, const int *ldfjac, const __minpack_real__ *tol,
int *info, __minpack_real__ *wa, const int *lwa );
/* find a zero of a system of N nonlinear functions in N variables by
a modification of the Powell hybrid method (user-supplied Jacobian,
more general) */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(hybrj)( __minpack_decl_fcnder_nn__ const int *n, __minpack_real__ *x,
__minpack_real__ *fvec, __minpack_real__ *fjec, const int *ldfjac, const __minpack_real__ *xtol,
const int *maxfev, __minpack_real__ *diag, const int *mode, const __minpack_real__ *factor,
const int *nprint, int *info, int *nfev, int *njev, __minpack_real__ *r,
const int *lr, __minpack_real__ *qtf, __minpack_real__ *wa1, __minpack_real__ *wa2,
__minpack_real__ *wa3, __minpack_real__ *wa4 );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(Jacobian calculated by a forward-difference approximation) */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(lmdif1)( __minpack_decl_fcn_mn__
const int *m, const int *n, __minpack_real__ *x, __minpack_real__ *fvec, const __minpack_real__ *tol,
int *info, int *iwa, __minpack_real__ *wa, const int *lwa );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(Jacobian calculated by a forward-difference approximation, more
general) */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(lmdif)( __minpack_decl_fcn_mn__
const int *m, const int *n, __minpack_real__ *x, __minpack_real__ *fvec, const __minpack_real__ *ftol,
const __minpack_real__ *xtol, const __minpack_real__ *gtol, const int *maxfev, const __minpack_real__ *epsfcn,
__minpack_real__ *diag, const int *mode, const __minpack_real__ *factor, const int *nprint,
int *info, int *nfev, __minpack_real__ *fjac, const int *ldfjac, int *ipvt,
__minpack_real__ *qtf, __minpack_real__ *wa1, __minpack_real__ *wa2, __minpack_real__ *wa3,
__minpack_real__ *wa4 );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(user-supplied Jacobian) */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(lmder1)( __minpack_decl_fcnder_mn__
const int *m, const int *n, __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac,
const int *ldfjac, const __minpack_real__ *tol, int *info, int *ipvt,
__minpack_real__ *wa, const int *lwa );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(user-supplied Jacobian, more general) */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(lmder)( __minpack_decl_fcnder_mn__
const int *m, const int *n, __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac,
const int *ldfjac, const __minpack_real__ *ftol, const __minpack_real__ *xtol, const __minpack_real__ *gtol,
const int *maxfev, __minpack_real__ *diag, const int *mode, const __minpack_real__ *factor,
const int *nprint, int *info, int *nfev, int *njev, int *ipvt,
__minpack_real__ *qtf, __minpack_real__ *wa1, __minpack_real__ *wa2, __minpack_real__ *wa3,
__minpack_real__ *wa4 );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(user-supplied Jacobian, minimal storage) */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(lmstr1)( __minpack_decl_fcnderstr_mn__ const int *m, const int *n,
__minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac, const int *ldfjac,
const __minpack_real__ *tol, int *info, int *ipvt, __minpack_real__ *wa, const int *lwa );
/* minimize the sum of the squares of nonlinear functions in N
variables by a modification of the Levenberg-Marquardt algorithm
(user-supplied Jacobian, minimal storage, more general) */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(lmstr)( __minpack_decl_fcnderstr_mn__ const int *m,
const int *n, __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac,
const int *ldfjac, const __minpack_real__ *ftol, const __minpack_real__ *xtol, const __minpack_real__ *gtol,
const int *maxfev, __minpack_real__ *diag, const int *mode, const __minpack_real__ *factor,
const int *nprint, int *info, int *nfev, int *njev, int *ipvt,
__minpack_real__ *qtf, __minpack_real__ *wa1, __minpack_real__ *wa2, __minpack_real__ *wa3,
__minpack_real__ *wa4 );
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(chkder)( const int *m, const int *n, const __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjec,
const int *ldfjac, __minpack_real__ *xp, __minpack_real__ *fvecp, const int *mode,
__minpack_real__ *err );
__minpack_attr__
__minpack_real__ MINPACK_EXPORT __minpack_func__(dpmpar)( const int *i );
__minpack_attr__
__minpack_real__ MINPACK_EXPORT __minpack_func__(enorm)( const int *n, const __minpack_real__ *x );
/* compute a forward-difference approximation to the m by n jacobian
matrix associated with a specified problem of m functions in n
variables. */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(fdjac2)(__minpack_decl_fcn_mn__
const int *m, const int *n, __minpack_real__ *x, const __minpack_real__ *fvec, __minpack_real__ *fjac,
const int *ldfjac, int *iflag, const __minpack_real__ *epsfcn, __minpack_real__ *wa);
/* compute a forward-difference approximation to the n by n jacobian
matrix associated with a specified problem of n functions in n
variables. if the jacobian has a banded form, then function
evaluations are saved by only approximating the nonzero terms. */
__minpack_attr__
void MINPACK_EXPORT __minpack_func__(fdjac1)(__minpack_decl_fcn_nn__
const int *n, __minpack_real__ *x, const __minpack_real__ *fvec, __minpack_real__ *fjac, const int *ldfjac,
int *iflag, const int *ml, const int *mu, const __minpack_real__ *epsfcn, __minpack_real__ *wa1,
__minpack_real__ *wa2);
/* internal MINPACK subroutines */
__minpack_attr__
void __minpack_func__(dogleg)(const int *n, const __minpack_real__ *r, const int *lr,
const __minpack_real__ *diag, const __minpack_real__ *qtb, const __minpack_real__ *delta, __minpack_real__ *x,
__minpack_real__ *wa1, __minpack_real__ *wa2);
__minpack_attr__
void __minpack_func__(qrfac)(const int *m, const int *n, __minpack_real__ *a, const int *
lda, const int *pivot, int *ipvt, const int *lipvt, __minpack_real__ *rdiag,
__minpack_real__ *acnorm, __minpack_real__ *wa);
__minpack_attr__
void __minpack_func__(qrsolv)(const int *n, __minpack_real__ *r, const int *ldr,
const int *ipvt, const __minpack_real__ *diag, const __minpack_real__ *qtb, __minpack_real__ *x,
__minpack_real__ *sdiag, __minpack_real__ *wa);
__minpack_attr__
void __minpack_func__(qform)(const int *m, const int *n, __minpack_real__ *q, const int *
ldq, __minpack_real__ *wa);
__minpack_attr__
void __minpack_func__(r1updt)(const int *m, const int *n, __minpack_real__ *s, const int *
ls, const __minpack_real__ *u, __minpack_real__ *v, __minpack_real__ *w, int *sing);
__minpack_attr__
void __minpack_func__(r1mpyq)(const int *m, const int *n, __minpack_real__ *a, const int *
lda, const __minpack_real__ *v, const __minpack_real__ *w);
__minpack_attr__
void __minpack_func__(lmpar)(const int *n, __minpack_real__ *r, const int *ldr,
const int *ipvt, const __minpack_real__ *diag, const __minpack_real__ *qtb, const __minpack_real__ *delta,
__minpack_real__ *par, __minpack_real__ *x, __minpack_real__ *sdiag, __minpack_real__ *wa1,
__minpack_real__ *wa2);
__minpack_attr__
void __minpack_func__(rwupdt)(const int *n, __minpack_real__ *r, const int *ldr,
const __minpack_real__ *w, __minpack_real__ *b, __minpack_real__ *alpha, __minpack_real__ *cos,
__minpack_real__ *sin);
__minpack_attr__
void __minpack_func__(covar)(const int *n, __minpack_real__ *r, const int *ldr,
const int *ipvt, const __minpack_real__ *tol, __minpack_real__ *wa);
#ifdef __cplusplus
}
#endif /* __cplusplus */
#endif /* __MINPACK_H__ */

View File

@ -1,50 +0,0 @@
/* Internal header file for cminpack, by Frederic Devernay. */
#ifndef __MINPACKP_H__
#define __MINPACKP_H__
#ifndef __CMINPACK_H__
#error "minpackP.h in an internal cminpack header, and must be included after all other headers (including cminpack.h)"
#endif
#include <float.h>
#define double_EPSILON DBL_EPSILON
#define double_MIN DBL_MIN
#define double_MAX DBL_MAX
#define long_double_EPSILON LDBL_EPSILON
#define long_double_MIN LDBL_MIN
#define long_double_MAX LDBL_MAX
#define float_EPSILON FLT_EPSILON
#define float_MIN FLT_MIN
#define float_MAX FLT_MAX
#define half_EPSILON HALF_EPSILON
#define half_MIN HALF_NRM_MIN
#define half_MAX HALF_MAX
#define real __cminpack_real__
#ifdef __cminpack_long_double__
#define realm long_double
#define fabs(x) fabsl(x)
#define sqrt(x) sqrtl(x)
#define log(x) logl(x)
#define exp(x) expl(x)
#define sin(x) sinl(x)
#define cos(x) cosl(x)
#define tan(x) tanl(x)
#define asin(x) asinl(x)
#define acos(x) acosl(x)
#define atan(x) atanl(x)
#define floor(x) floorl(x)
#define ceil(x) ceill(x)
extern long double floorl ( long double );
extern long double ellpkl ( long double );
#else
#define realm real
#endif
#define min(a,b) ((a) <= (b) ? (a) : (b))
#define max(a,b) ((a) >= (b) ? (a) : (b))
#define abs(x) ((x) >= 0 ? (x) : -(x))
#define TRUE_ (1)
#define FALSE_ (0)
#endif /* !__MINPACKP_H__ */

View File

@ -1,116 +0,0 @@
/* qform.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include "cminpackP.h"
__cminpack_attr__
void __cminpack_func__(qform)(int m, int n, real *q, int
ldq, real *wa)
{
/* System generated locals */
int q_dim1, q_offset;
/* Local variables */
int i, j, k, l, jm1, np1;
real sum, temp;
int minmn;
/* ********** */
/* subroutine qform */
/* this subroutine proceeds from the computed qr factorization of */
/* an m by n matrix a to accumulate the m by m orthogonal matrix */
/* q from its factored form. */
/* the subroutine statement is */
/* subroutine qform(m,n,q,ldq,wa) */
/* where */
/* m is a positive integer input variable set to the number */
/* of rows of a and the order of q. */
/* n is a positive integer input variable set to the number */
/* of columns of a. */
/* q is an m by m array. on input the full lower trapezoid in */
/* the first min(m,n) columns of q contains the factored form. */
/* on output q has been accumulated into a square matrix. */
/* ldq is a positive integer input variable not less than m */
/* which specifies the leading dimension of the array q. */
/* wa is a work array of length m. */
/* subprograms called */
/* fortran-supplied ... min0 */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa;
q_dim1 = ldq;
q_offset = 1 + q_dim1 * 1;
q -= q_offset;
/* Function Body */
/* zero out upper triangle of q in the first min(m,n) columns. */
minmn = min(m,n);
if (minmn >= 2) {
for (j = 2; j <= minmn; ++j) {
jm1 = j - 1;
for (i = 1; i <= jm1; ++i) {
q[i + j * q_dim1] = 0.;
}
}
}
/* initialize remaining columns to those of the identity matrix. */
np1 = n + 1;
if (m >= np1) {
for (j = np1; j <= m; ++j) {
for (i = 1; i <= m; ++i) {
q[i + j * q_dim1] = 0.;
}
q[j + j * q_dim1] = 1.;
}
}
/* accumulate q from its factored form. */
for (l = 1; l <= minmn; ++l) {
k = minmn - l + 1;
for (i = k; i <= m; ++i) {
wa[i] = q[i + k * q_dim1];
q[i + k * q_dim1] = 0.;
}
q[k + k * q_dim1] = 1.;
if (wa[k] != 0.) {
for (j = k; j <= m; ++j) {
sum = 0.;
for (i = k; i <= m; ++i) {
sum += q[i + j * q_dim1] * wa[i];
}
temp = sum / wa[k];
for (i = k; i <= m; ++i) {
q[i + j * q_dim1] -= temp * wa[i];
}
}
}
}
/* last card of subroutine qform. */
} /* qform_ */

View File

@ -1,144 +0,0 @@
/* qform.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(qform)(const int *m, const int *n, real *q, const int *
ldq, real *wa)
{
/* System generated locals */
int q_dim1, q_offset, i__1, i__2, i__3;
/* Local variables */
int i__, j, k, l, jm1, np1;
real sum, temp;
int minmn;
/* ********** */
/* subroutine qform */
/* this subroutine proceeds from the computed qr factorization of */
/* an m by n matrix a to accumulate the m by m orthogonal matrix */
/* q from its factored form. */
/* the subroutine statement is */
/* subroutine qform(m,n,q,ldq,wa) */
/* where */
/* m is a positive integer input variable set to the number */
/* of rows of a and the order of q. */
/* n is a positive integer input variable set to the number */
/* of columns of a. */
/* q is an m by m array. on input the full lower trapezoid in */
/* the first min(m,n) columns of q contains the factored form. */
/* on output q has been accumulated into a square matrix. */
/* ldq is a positive integer input variable not less than m */
/* which specifies the leading dimension of the array q. */
/* wa is a work array of length m. */
/* subprograms called */
/* fortran-supplied ... min0 */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa;
q_dim1 = *ldq;
q_offset = 1 + q_dim1 * 1;
q -= q_offset;
/* Function Body */
/* zero out upper triangle of q in the first min(m,n) columns. */
minmn = min(*m,*n);
if (minmn < 2) {
goto L30;
}
i__1 = minmn;
for (j = 2; j <= i__1; ++j) {
jm1 = j - 1;
i__2 = jm1;
for (i__ = 1; i__ <= i__2; ++i__) {
q[i__ + j * q_dim1] = 0.;
/* L10: */
}
/* L20: */
}
L30:
/* initialize remaining columns to those of the identity matrix. */
np1 = *n + 1;
if (*m < np1) {
goto L60;
}
i__1 = *m;
for (j = np1; j <= i__1; ++j) {
i__2 = *m;
for (i__ = 1; i__ <= i__2; ++i__) {
q[i__ + j * q_dim1] = 0.;
/* L40: */
}
q[j + j * q_dim1] = 1.;
/* L50: */
}
L60:
/* accumulate q from its factored form. */
i__1 = minmn;
for (l = 1; l <= i__1; ++l) {
k = minmn - l + 1;
i__2 = *m;
for (i__ = k; i__ <= i__2; ++i__) {
wa[i__] = q[i__ + k * q_dim1];
q[i__ + k * q_dim1] = 0.;
/* L70: */
}
q[k + k * q_dim1] = 1.;
if (wa[k] == 0.) {
goto L110;
}
i__2 = *m;
for (j = k; j <= i__2; ++j) {
sum = 0.;
i__3 = *m;
for (i__ = k; i__ <= i__3; ++i__) {
sum += q[i__ + j * q_dim1] * wa[i__];
/* L80: */
}
temp = sum / wa[k];
i__3 = *m;
for (i__ = k; i__ <= i__3; ++i__) {
q[i__ + j * q_dim1] -= temp * wa[i__];
/* L90: */
}
/* L100: */
}
L110:
/* L120: */
;
}
return;
/* last card of subroutine qform. */
} /* qform_ */

View File

@ -1,285 +0,0 @@
#include "cminpack.h"
#include <math.h>
#ifdef USE_LAPACK
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#endif
#include "cminpackP.h"
__cminpack_attr__
void __cminpack_func__(qrfac)(int m, int n, real *a, int
lda, int pivot, int *ipvt, int lipvt, real *rdiag,
real *acnorm, real *wa)
{
#ifdef USE_LAPACK
__CLPK_integer m_ = m;
__CLPK_integer n_ = n;
__CLPK_integer lda_ = lda;
__CLPK_integer *jpvt;
int i, j, k;
double t;
double* tau = wa;
const __CLPK_integer ltau = m > n ? n : m;
__CLPK_integer lwork = -1;
__CLPK_integer info = 0;
double* work;
if (pivot) {
assert( lipvt >= n );
if (sizeof(__CLPK_integer) != sizeof(ipvt[0])) {
jpvt = malloc(n*sizeof(__CLPK_integer));
} else {
/* __CLPK_integer is actually an int, just do a cast */
jpvt = (__CLPK_integer *)ipvt;
}
/* set all columns free */
memset(jpvt, 0, sizeof(int)*n);
}
/* query optimal size of work */
lwork = -1;
if (pivot) {
dgeqp3_(&m_,&n_,a,&lda_,jpvt,tau,tau,&lwork,&info);
lwork = (int)tau[0];
assert( lwork >= 3*n+1 );
} else {
dgeqrf_(&m_,&n_,a,&lda_,tau,tau,&lwork,&info);
lwork = (int)tau[0];
assert( lwork >= 1 && lwork >= n );
}
assert( info == 0 );
/* alloc work area */
work = (double *)malloc(sizeof(double)*lwork);
assert(work != NULL);
/* set acnorm first (from the doc of qrfac, acnorm may point to the same area as rdiag) */
if (acnorm != rdiag) {
for (j = 0; j < n; ++j) {
acnorm[j] = __cminpack_enorm__(m, &a[j * lda]);
}
}
/* QR decomposition */
if (pivot) {
dgeqp3_(&m_,&n_,a,&lda_,jpvt,tau,work,&lwork,&info);
} else {
dgeqrf_(&m_,&n_,a,&lda_,tau,work,&lwork,&info);
}
assert(info == 0);
/* set rdiag, before the diagonal is replaced */
memset(rdiag, 0, sizeof(double)*n);
for(i=0 ; i<n ; ++i) {
rdiag[i] = a[i*lda+i];
}
/* modify lower trinagular part to look like qrfac's output */
for(i=0 ; i<ltau ; ++i) {
k = i*lda+i;
t = tau[i];
a[k] = t;
for(j=i+1 ; j<m ; j++) {
k++;
a[k] *= t;
}
}
free(work);
if (pivot) {
/* convert back jpvt to ipvt */
if (sizeof(__CLPK_integer) != sizeof(ipvt[0])) {
for(i=0; i<n; ++i) {
ipvt[i] = jpvt[i];
}
free(jpvt);
}
}
#else /* !USE_LAPACK */
/* Initialized data */
#define p05 .05
/* System generated locals */
real d1;
/* Local variables */
int i, j, k, jp1;
real sum;
real temp;
int minmn;
real epsmch;
real ajnorm;
/* ********** */
/* 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. */
/* subprograms called */
/* minpack-supplied ... dpmpar,enorm */
/* fortran-supplied ... dmax1,dsqrt,min0 */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
(void)lipvt;
/* epsmch is the machine precision. */
epsmch = __cminpack_func__(dpmpar)(1);
/* compute the initial column norms and initialize several arrays. */
for (j = 0; j < n; ++j) {
acnorm[j] = __cminpack_enorm__(m, &a[j * lda + 0]);
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) {
/* bring the column of largest norm into the pivot position. */
int kmax = j;
for (k = j; k < n; ++k) {
if (rdiag[k] > rdiag[kmax]) {
kmax = k;
}
}
if (kmax != j) {
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;
}
}
/* compute the householder transformation to reduce the */
/* j-th column of a to a multiple of the j-th unit vector. */
ajnorm = __cminpack_enorm__(m - (j+1) + 1, &a[j + j * lda]);
if (ajnorm != 0.) {
if (a[j + j * lda] < 0.) {
ajnorm = -ajnorm;
}
for (i = j; i < m; ++i) {
a[i + j * lda] /= ajnorm;
}
a[j + j * lda] += 1.;
/* apply the transformation to the remaining columns */
/* and update the norms. */
jp1 = j + 1;
if (n > jp1) {
for (k = jp1; k < n; ++k) {
sum = 0.;
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] != 0.) {
temp = a[j + k * lda] / rdiag[k];
/* Computing MAX */
d1 = 1. - temp * temp;
rdiag[k] *= sqrt((max((real)0.,d1)));
/* Computing 2nd power */
d1 = rdiag[k] / wa[k];
if (p05 * (d1 * d1) <= epsmch) {
rdiag[k] = __cminpack_enorm__(m - (j+1), &a[jp1 + k * lda]);
wa[k] = rdiag[k];
}
}
}
}
}
rdiag[j] = -ajnorm;
}
/* last card of subroutine qrfac. */
#endif /* !USE_LAPACK */
} /* qrfac_ */

View File

@ -1,243 +0,0 @@
/* qrfac.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(qrfac)(const int *m, const int *n, real *a, const int *
lda, const int *pivot, int *ipvt, const int *lipvt, real *rdiag,
real *acnorm, real *wa)
{
/* Initialized data */
#define p05 .05
const int c__1 = 1;
/* System generated locals */
int a_dim1, a_offset, i__1, i__2, i__3;
real d__1, d__2, d__3;
/* Local variables */
int i__, j, k, jp1;
real sum;
int kmax;
real temp;
int minmn;
real epsmch;
real ajnorm;
/* ********** */
/* 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. */
/* subprograms called */
/* minpack-supplied ... dpmpar,enorm */
/* fortran-supplied ... dmax1,dsqrt,min0 */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa;
--acnorm;
--rdiag;
a_dim1 = *lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
--ipvt;
(void)lipvt;
/* Function Body */
/* epsmch is the machine precision. */
epsmch = __minpack_func__(dpmpar)(&c__1);
/* compute the initial column norms and initialize several arrays. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
acnorm[j] = __minpack_func__(enorm)(m, &a[j * a_dim1 + 1]);
rdiag[j] = acnorm[j];
wa[j] = rdiag[j];
if (*pivot) {
ipvt[j] = j;
}
/* L10: */
}
/* reduce a to r with householder transformations. */
minmn = min(*m,*n);
i__1 = minmn;
for (j = 1; j <= i__1; ++j) {
if (! (*pivot)) {
goto L40;
}
/* bring the column of largest norm into the pivot position. */
kmax = j;
i__2 = *n;
for (k = j; k <= i__2; ++k) {
if (rdiag[k] > rdiag[kmax]) {
kmax = k;
}
/* L20: */
}
if (kmax == j) {
goto L40;
}
i__2 = *m;
for (i__ = 1; i__ <= i__2; ++i__) {
temp = a[i__ + j * a_dim1];
a[i__ + j * a_dim1] = a[i__ + kmax * a_dim1];
a[i__ + kmax * a_dim1] = temp;
/* L30: */
}
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__2 = *m - j + 1;
ajnorm = __minpack_func__(enorm)(&i__2, &a[j + j * a_dim1]);
if (ajnorm == 0.) {
goto L100;
}
if (a[j + j * a_dim1] < 0.) {
ajnorm = -ajnorm;
}
i__2 = *m;
for (i__ = j; i__ <= i__2; ++i__) {
a[i__ + j * a_dim1] /= ajnorm;
/* L50: */
}
a[j + j * a_dim1] += 1.;
/* apply the transformation to the remaining columns */
/* and update the norms. */
jp1 = j + 1;
if (*n < jp1) {
goto L100;
}
i__2 = *n;
for (k = jp1; k <= i__2; ++k) {
sum = 0.;
i__3 = *m;
for (i__ = j; i__ <= i__3; ++i__) {
sum += a[i__ + j * a_dim1] * a[i__ + k * a_dim1];
/* L60: */
}
temp = sum / a[j + j * a_dim1];
i__3 = *m;
for (i__ = j; i__ <= i__3; ++i__) {
a[i__ + k * a_dim1] -= temp * a[i__ + j * a_dim1];
/* L70: */
}
if (! (*pivot) || rdiag[k] == 0.) {
goto L80;
}
temp = a[j + k * a_dim1] / rdiag[k];
/* Computing MAX */
/* Computing 2nd power */
d__3 = temp;
d__1 = 0., d__2 = 1. - d__3 * d__3;
rdiag[k] *= sqrt((max(d__1,d__2)));
/* Computing 2nd power */
d__1 = rdiag[k] / wa[k];
if (p05 * (d__1 * d__1) > epsmch) {
goto L80;
}
i__3 = *m - j;
rdiag[k] = __minpack_func__(enorm)(&i__3, &a[jp1 + k * a_dim1]);
wa[k] = rdiag[k];
L80:
/* L90: */
;
}
L100:
rdiag[j] = -ajnorm;
/* L110: */
}
return;
/* last card of subroutine qrfac. */
} /* qrfac_ */

View File

@ -1,218 +0,0 @@
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
void __cminpack_func__(qrsolv)(int n, real *r, int ldr,
const int *ipvt, const real *diag, const real *qtb, real *x,
real *sdiag, real *wa)
{
/* Initialized data */
#define p5 .5
#define p25 .25
/* Local variables */
int i, j, k, l;
real cos, sin, sum, temp;
int nsing;
real qtbpj;
/* ********** */
/* 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. */
/* subprograms called */
/* fortran-supplied ... dabs,dsqrt */
/* 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.) {
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.) {
# ifdef USE_LAPACK
dlartg_( &r[k + k * ldr], &sdiag[k], &cos, &sin, &temp );
# else /* !USE_LAPACK */
if (fabs(r[k + k * ldr]) < fabs(sdiag[k])) {
real cotan;
cotan = r[k + k * ldr] / sdiag[k];
sin = p5 / sqrt(p25 + p25 * (cotan * cotan));
cos = sin * cotan;
} else {
real tan;
tan = sdiag[k] / r[k + k * ldr];
cos = p5 / sqrt(p25 + p25 * (tan * tan));
sin = cos * tan;
}
/* compute the modified diagonal element of r and */
/* the modified element of ((q transpose)*b,0). */
# endif /* !USE_LAPACK */
temp = cos * wa[k] + sin * qtbpj;
qtbpj = -sin * wa[k] + cos * qtbpj;
wa[k] = temp;
/* accumulate the tranformation in the row of s. */
# ifdef USE_CBLAS
cblas_drot( n-k, &r[k + k * ldr], 1, &sdiag[k], 1, cos, sin );
# else /* !USE_CBLAS */
r[k + k * ldr] = cos * r[k + k * ldr] + sin * sdiag[k];
if (n > k+1) {
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;
}
}
# endif /* !USE_CBLAS */
}
}
}
/* 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.;
}
}
if (nsing >= 1) {
for (k = 1; k <= nsing; ++k) {
j = nsing - k;
sum = 0.;
if (nsing > j+1) {
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];
}
return;
/* last card of subroutine qrsolv. */
} /* qrsolv_ */

View File

@ -1,273 +0,0 @@
/* qrsolv.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(qrsolv)(const int *n, real *r__, const int *ldr,
const int *ipvt, const real *diag, const real *qtb, real *x,
real *sdiag, real *wa)
{
/* Initialized data */
#define p5 .5
#define p25 .25
/* System generated locals */
int r_dim1, r_offset, i__1, i__2, i__3;
real d__1, d__2;
/* Local variables */
int i__, j, k, l, jp1, kp1;
real tan__, cos__, sin__, sum, temp, cotan;
int nsing;
real qtbpj;
/* ********** */
/* 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. */
/* subprograms called */
/* fortran-supplied ... dabs,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--wa;
--sdiag;
--x;
--qtb;
--diag;
--ipvt;
r_dim1 = *ldr;
r_offset = 1 + r_dim1 * 1;
r__ -= r_offset;
/* Function Body */
/* copy r and (q transpose)*b to preserve input and initialize s. */
/* in particular, save the diagonal elements of r in x. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
i__2 = *n;
for (i__ = j; i__ <= i__2; ++i__) {
r__[i__ + j * r_dim1] = r__[j + i__ * r_dim1];
/* L10: */
}
x[j] = r__[j + j * r_dim1];
wa[j] = qtb[j];
/* L20: */
}
/* eliminate the diagonal matrix d using a givens rotation. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
/* prepare the row of d to be eliminated, locating the */
/* diagonal element using p from the qr factorization. */
l = ipvt[j];
if (diag[l] == 0.) {
goto L90;
}
i__2 = *n;
for (k = j; k <= i__2; ++k) {
sdiag[k] = 0.;
/* L30: */
}
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.;
i__2 = *n;
for (k = j; k <= i__2; ++k) {
/* determine a givens rotation which eliminates the */
/* appropriate element in the current row of d. */
if (sdiag[k] == 0.) {
goto L70;
}
if ((d__1 = r__[k + k * r_dim1], abs(d__1)) >= (d__2 = sdiag[k],
abs(d__2))) {
goto L40;
}
cotan = r__[k + k * r_dim1] / sdiag[k];
/* Computing 2nd power */
d__1 = cotan;
sin__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
cos__ = sin__ * cotan;
goto L50;
L40:
tan__ = sdiag[k] / r__[k + k * r_dim1];
/* Computing 2nd power */
d__1 = tan__;
cos__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
sin__ = cos__ * tan__;
L50:
/* compute the modified diagonal element of r and */
/* the modified element of ((q transpose)*b,0). */
r__[k + k * r_dim1] = cos__ * r__[k + k * r_dim1] + sin__ * sdiag[
k];
temp = cos__ * wa[k] + sin__ * qtbpj;
qtbpj = -sin__ * wa[k] + cos__ * qtbpj;
wa[k] = temp;
/* accumulate the tranformation in the row of s. */
kp1 = k + 1;
if (*n < kp1) {
goto L70;
}
i__3 = *n;
for (i__ = kp1; i__ <= i__3; ++i__) {
temp = cos__ * r__[i__ + k * r_dim1] + sin__ * sdiag[i__];
sdiag[i__] = -sin__ * r__[i__ + k * r_dim1] + cos__ * sdiag[
i__];
r__[i__ + k * r_dim1] = temp;
/* L60: */
}
L70:
/* L80: */
;
}
L90:
/* store the diagonal element of s and restore */
/* the corresponding diagonal element of r. */
sdiag[j] = r__[j + j * r_dim1];
r__[j + j * r_dim1] = x[j];
/* L100: */
}
/* solve the triangular system for z. if the system is */
/* singular, then obtain a least squares solution. */
nsing = *n;
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
if (sdiag[j] == 0. && nsing == *n) {
nsing = j - 1;
}
if (nsing < *n) {
wa[j] = 0.;
}
/* L110: */
}
if (nsing < 1) {
goto L150;
}
i__1 = nsing;
for (k = 1; k <= i__1; ++k) {
j = nsing - k + 1;
sum = 0.;
jp1 = j + 1;
if (nsing < jp1) {
goto L130;
}
i__2 = nsing;
for (i__ = jp1; i__ <= i__2; ++i__) {
sum += r__[i__ + j * r_dim1] * wa[i__];
/* L120: */
}
L130:
wa[j] = (wa[j] - sum) / sdiag[j];
/* L140: */
}
L150:
/* permute the components of z back to components of x. */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
l = ipvt[j];
x[l] = wa[j];
/* L160: */
}
return;
/* last card of subroutine qrsolv. */
} /* qrsolv_ */

View File

@ -1,122 +0,0 @@
/* r1mpyq.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
void __cminpack_func__(r1mpyq)(int m, int n, real *a, int
lda, const real *v, const real *w)
{
/* System generated locals */
int a_dim1, a_offset;
/* Local variables */
int i, j, nm1, nmj;
real cos, sin, temp;
/* ********** */
/* subroutine r1mpyq */
/* given an m by n matrix a, this subroutine computes a*q where */
/* q is the product of 2*(n - 1) transformations */
/* gv(n-1)*...*gv(1)*gw(1)*...*gw(n-1) */
/* and gv(i), gw(i) are givens rotations in the (i,n) plane which */
/* eliminate elements in the i-th and n-th planes, respectively. */
/* q itself is not given, rather the information to recover the */
/* gv, gw rotations is supplied. */
/* the subroutine statement is */
/* subroutine r1mpyq(m,n,a,lda,v,w) */
/* 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 must contain the matrix */
/* to be postmultiplied by the orthogonal matrix q */
/* described above. on output a*q has replaced a. */
/* lda is a positive integer input variable not less than m */
/* which specifies the leading dimension of the array a. */
/* v is an input array of length n. v(i) must contain the */
/* information necessary to recover the givens rotation gv(i) */
/* described above. */
/* w is an input array of length n. w(i) must contain the */
/* information necessary to recover the givens rotation gw(i) */
/* described above. */
/* subroutines called */
/* fortran-supplied ... dabs,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--w;
--v;
a_dim1 = lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
/* Function Body */
/* apply the first set of givens rotations to a. */
nm1 = n - 1;
if (nm1 < 1) {
return;
}
for (nmj = 1; nmj <= nm1; ++nmj) {
j = n - nmj;
if (fabs(v[j]) > 1.) {
cos = 1. / v[j];
sin = sqrt(1. - cos * cos);
} else {
sin = v[j];
cos = sqrt(1. - sin * sin);
}
for (i = 1; i <= m; ++i) {
temp = cos * a[i + j * a_dim1] - sin * a[i + n * a_dim1];
a[i + n * a_dim1] = sin * a[i + j * a_dim1] + cos * a[
i + n * a_dim1];
a[i + j * a_dim1] = temp;
}
}
/* apply the second set of givens rotations to a. */
for (j = 1; j <= nm1; ++j) {
if (fabs(w[j]) > 1.) {
cos = 1. / w[j];
sin = sqrt(1. - cos * cos);
} else {
sin = w[j];
cos = sqrt(1. - sin * sin);
}
for (i = 1; i <= m; ++i) {
temp = cos * a[i + j * a_dim1] + sin * a[i + n * a_dim1];
a[i + n * a_dim1] = -sin * a[i + j * a_dim1] + cos * a[i + n * a_dim1];
a[i + j * a_dim1] = temp;
}
}
/* last card of subroutine r1mpyq. */
} /* r1mpyq_ */

View File

@ -1,144 +0,0 @@
/* r1mpyq.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(r1mpyq)(const int *m, const int *n, real *a, const int *
lda, const real *v, const real *w)
{
/* System generated locals */
int a_dim1, a_offset, i__1, i__2;
real d__1, d__2;
/* Local variables */
int i__, j, nm1, nmj;
real cos__, sin__, temp;
/* ********** */
/* subroutine r1mpyq */
/* given an m by n matrix a, this subroutine computes a*q where */
/* q is the product of 2*(n - 1) transformations */
/* gv(n-1)*...*gv(1)*gw(1)*...*gw(n-1) */
/* and gv(i), gw(i) are givens rotations in the (i,n) plane which */
/* eliminate elements in the i-th and n-th planes, respectively. */
/* q itself is not given, rather the information to recover the */
/* gv, gw rotations is supplied. */
/* the subroutine statement is */
/* subroutine r1mpyq(m,n,a,lda,v,w) */
/* 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 must contain the matrix */
/* to be postmultiplied by the orthogonal matrix q */
/* described above. on output a*q has replaced a. */
/* lda is a positive integer input variable not less than m */
/* which specifies the leading dimension of the array a. */
/* v is an input array of length n. v(i) must contain the */
/* information necessary to recover the givens rotation gv(i) */
/* described above. */
/* w is an input array of length n. w(i) must contain the */
/* information necessary to recover the givens rotation gw(i) */
/* described above. */
/* subroutines called */
/* fortran-supplied ... dabs,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--w;
--v;
a_dim1 = *lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
/* Function Body */
/* apply the first set of givens rotations to a. */
nm1 = *n - 1;
if (nm1 < 1) {
/* goto L50; */
return;
}
i__1 = nm1;
for (nmj = 1; nmj <= i__1; ++nmj) {
j = *n - nmj;
if ((d__1 = v[j], abs(d__1)) > 1.) {
cos__ = 1. / v[j];
/* Computing 2nd power */
d__2 = cos__;
sin__ = sqrt(1. - d__2 * d__2);
} else {
sin__ = v[j];
/* Computing 2nd power */
d__2 = sin__;
cos__ = sqrt(1. - d__2 * d__2);
}
i__2 = *m;
for (i__ = 1; i__ <= i__2; ++i__) {
temp = cos__ * a[i__ + j * a_dim1] - sin__ * a[i__ + *n * a_dim1];
a[i__ + *n * a_dim1] = sin__ * a[i__ + j * a_dim1] + cos__ * a[
i__ + *n * a_dim1];
a[i__ + j * a_dim1] = temp;
/* L10: */
}
/* L20: */
}
/* apply the second set of givens rotations to a. */
i__1 = nm1;
for (j = 1; j <= i__1; ++j) {
if ((d__1 = w[j], abs(d__1)) > 1.) {
cos__ = 1. / w[j];
/* Computing 2nd power */
d__2 = cos__;
sin__ = sqrt(1. - d__2 * d__2);
} else {
sin__ = w[j];
/* Computing 2nd power */
d__2 = sin__;
cos__ = sqrt(1. - d__2 * d__2);
}
i__2 = *m;
for (i__ = 1; i__ <= i__2; ++i__) {
temp = cos__ * a[i__ + j * a_dim1] + sin__ * a[i__ + *n * a_dim1];
a[i__ + *n * a_dim1] = -sin__ * a[i__ + j * a_dim1] + cos__ * a[
i__ + *n * a_dim1];
a[i__ + j * a_dim1] = temp;
/* L30: */
}
/* L40: */
}
/* L50: */
return;
/* last card of subroutine r1mpyq. */
} /* r1mpyq_ */

View File

@ -1,236 +0,0 @@
/* r1updt.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
void __cminpack_func__(r1updt)(int m, int n, real *s, int
ls, const real *u, real *v, real *w, int *sing)
{
/* Initialized data */
#define p5 .5
#define p25 .25
/* Local variables */
int i, j, l, jj, nm1;
real tan;
int nmj;
real cos, sin, tau, temp, giant, cotan;
/* ********** */
/* subroutine r1updt */
/* given an m by n lower trapezoidal matrix s, an m-vector u, */
/* and an n-vector v, the problem is to determine an */
/* orthogonal matrix q such that */
/* t */
/* (s + u*v )*q */
/* is again lower trapezoidal. */
/* this subroutine determines q as the product of 2*(n - 1) */
/* transformations */
/* gv(n-1)*...*gv(1)*gw(1)*...*gw(n-1) */
/* where gv(i), gw(i) are givens rotations in the (i,n) plane */
/* which eliminate elements in the i-th and n-th planes, */
/* respectively. q itself is not accumulated, rather the */
/* information to recover the gv, gw rotations is returned. */
/* the subroutine statement is */
/* subroutine r1updt(m,n,s,ls,u,v,w,sing) */
/* where */
/* m is a positive integer input variable set to the number */
/* of rows of s. */
/* n is a positive integer input variable set to the number */
/* of columns of s. n must not exceed m. */
/* s is an array of length ls. on input s must contain the lower */
/* trapezoidal matrix s stored by columns. on output s contains */
/* the lower trapezoidal matrix produced as described above. */
/* ls is a positive integer input variable not less than */
/* (n*(2*m-n+1))/2. */
/* u is an input array of length m which must contain the */
/* vector u. */
/* v is an array of length n. on input v must contain the vector */
/* v. on output v(i) contains the information necessary to */
/* recover the givens rotation gv(i) described above. */
/* w is an output array of length m. w(i) contains information */
/* necessary to recover the givens rotation gw(i) described */
/* above. */
/* sing is a logical output variable. sing is set true if any */
/* of the diagonal elements of the output s are zero. otherwise */
/* sing is set false. */
/* subprograms called */
/* minpack-supplied ... dpmpar */
/* fortran-supplied ... dabs,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more, */
/* john l. nazareth */
/* ********** */
/* Parameter adjustments */
--w;
--u;
--v;
--s;
(void)ls;
/* Function Body */
/* giant is the largest magnitude. */
giant = __cminpack_func__(dpmpar)(3);
/* initialize the diagonal element pointer. */
jj = n * ((m << 1) - n + 1) / 2 - (m - n);
/* move the nontrivial part of the last column of s into w. */
l = jj;
for (i = n; i <= m; ++i) {
w[i] = s[l];
++l;
}
/* rotate the vector v into a multiple of the n-th unit vector */
/* in such a way that a spike is introduced into w. */
nm1 = n - 1;
if (nm1 >= 1) {
for (nmj = 1; nmj <= nm1; ++nmj) {
j = n - nmj;
jj -= m - j + 1;
w[j] = 0.;
if (v[j] != 0.) {
/* determine a givens rotation which eliminates the */
/* j-th element of v. */
if (fabs(v[n]) < fabs(v[j])) {
cotan = v[n] / v[j];
sin = p5 / sqrt(p25 + p25 * (cotan * cotan));
cos = sin * cotan;
tau = 1.;
if (fabs(cos) * giant > 1.) {
tau = 1. / cos;
}
} else {
tan = v[j] / v[n];
cos = p5 / sqrt(p25 + p25 * (tan * tan));
sin = cos * tan;
tau = sin;
}
/* apply the transformation to v and store the information */
/* necessary to recover the givens rotation. */
v[n] = sin * v[j] + cos * v[n];
v[j] = tau;
/* apply the transformation to s and extend the spike in w. */
l = jj;
for (i = j; i <= m; ++i) {
temp = cos * s[l] - sin * w[i];
w[i] = sin * s[l] + cos * w[i];
s[l] = temp;
++l;
}
}
}
}
/* add the spike from the rank 1 update to w. */
for (i = 1; i <= m; ++i) {
w[i] += v[n] * u[i];
}
/* eliminate the spike. */
*sing = FALSE_;
if (nm1 >= 1) {
for (j = 1; j <= nm1; ++j) {
if (w[j] != 0.) {
/* determine a givens rotation which eliminates the */
/* j-th element of the spike. */
if (fabs(s[jj]) < fabs(w[j])) {
cotan = s[jj] / w[j];
sin = p5 / sqrt(p25 + p25 * (cotan * cotan));
cos = sin * cotan;
tau = 1.;
if (fabs(cos) * giant > 1.) {
tau = 1. / cos;
}
} else {
tan = w[j] / s[jj];
cos = p5 / sqrt(p25 + p25 * (tan * tan));
sin = cos * tan;
tau = sin;
}
/* apply the transformation to s and reduce the spike in w. */
l = jj;
for (i = j; i <= m; ++i) {
temp = cos * s[l] + sin * w[i];
w[i] = -sin * s[l] + cos * w[i];
s[l] = temp;
++l;
}
/* store the information necessary to recover the */
/* givens rotation. */
w[j] = tau;
}
/* test for zero diagonal elements in the output s. */
if (s[jj] == 0.) {
*sing = TRUE_;
}
jj += m - j + 1;
}
}
/* move w back into the last column of the output s. */
l = jj;
for (i = n; i <= m; ++i) {
s[l] = w[i];
++l;
}
if (s[jj] == 0.) {
*sing = TRUE_;
}
/* last card of subroutine r1updt. */
} /* __minpack_func__(r1updt) */

View File

@ -1,279 +0,0 @@
/* r1updt.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(r1updt)(const int *m, const int *n, real *s, const int *
ls, const real *u, real *v, real *w, int *sing)
{
/* Initialized data */
#define p5 .5
#define p25 .25
const int c__3 = 3;
/* System generated locals */
int i__1, i__2;
real d__1, d__2;
/* Local variables */
int i__, j, l, jj, nm1;
real tan__;
int nmj;
real cos__, sin__, tau, temp, giant, cotan;
/* ********** */
/* subroutine r1updt */
/* given an m by n lower trapezoidal matrix s, an m-vector u, */
/* and an n-vector v, the problem is to determine an */
/* orthogonal matrix q such that */
/* t */
/* (s + u*v )*q */
/* is again lower trapezoidal. */
/* this subroutine determines q as the product of 2*(n - 1) */
/* transformations */
/* gv(n-1)*...*gv(1)*gw(1)*...*gw(n-1) */
/* where gv(i), gw(i) are givens rotations in the (i,n) plane */
/* which eliminate elements in the i-th and n-th planes, */
/* respectively. q itself is not accumulated, rather the */
/* information to recover the gv, gw rotations is returned. */
/* the subroutine statement is */
/* subroutine r1updt(m,n,s,ls,u,v,w,sing) */
/* where */
/* m is a positive integer input variable set to the number */
/* of rows of s. */
/* n is a positive integer input variable set to the number */
/* of columns of s. n must not exceed m. */
/* s is an array of length ls. on input s must contain the lower */
/* trapezoidal matrix s stored by columns. on output s contains */
/* the lower trapezoidal matrix produced as described above. */
/* ls is a positive integer input variable not less than */
/* (n*(2*m-n+1))/2. */
/* u is an input array of length m which must contain the */
/* vector u. */
/* v is an array of length n. on input v must contain the vector */
/* v. on output v(i) contains the information necessary to */
/* recover the givens rotation gv(i) described above. */
/* w is an output array of length m. w(i) contains information */
/* necessary to recover the givens rotation gw(i) described */
/* above. */
/* sing is a logical output variable. sing is set true if any */
/* of the diagonal elements of the output s are zero. otherwise */
/* sing is set false. */
/* subprograms called */
/* minpack-supplied ... dpmpar */
/* fortran-supplied ... dabs,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more, */
/* john l. nazareth */
/* ********** */
/* Parameter adjustments */
--w;
--u;
--v;
--s;
(void)ls;
/* Function Body */
/* giant is the largest magnitude. */
giant = __minpack_func__(dpmpar)(&c__3);
/* initialize the diagonal element pointer. */
jj = *n * ((*m << 1) - *n + 1) / 2 - (*m - *n);
/* move the nontrivial part of the last column of s into w. */
l = jj;
i__1 = *m;
for (i__ = *n; i__ <= i__1; ++i__) {
w[i__] = s[l];
++l;
/* L10: */
}
/* rotate the vector v into a multiple of the n-th unit vector */
/* in such a way that a spike is introduced into w. */
nm1 = *n - 1;
if (nm1 < 1) {
goto L70;
}
i__1 = nm1;
for (nmj = 1; nmj <= i__1; ++nmj) {
j = *n - nmj;
jj -= *m - j + 1;
w[j] = 0.;
if (v[j] == 0.) {
goto L50;
}
/* determine a givens rotation which eliminates the */
/* j-th element of v. */
if ((d__1 = v[*n], abs(d__1)) >= (d__2 = v[j], abs(d__2))) {
goto L20;
}
cotan = v[*n] / v[j];
/* Computing 2nd power */
d__1 = cotan;
sin__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
cos__ = sin__ * cotan;
tau = 1.;
if (abs(cos__) * giant > 1.) {
tau = 1. / cos__;
}
goto L30;
L20:
tan__ = v[j] / v[*n];
/* Computing 2nd power */
d__1 = tan__;
cos__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
sin__ = cos__ * tan__;
tau = sin__;
L30:
/* apply the transformation to v and store the information */
/* necessary to recover the givens rotation. */
v[*n] = sin__ * v[j] + cos__ * v[*n];
v[j] = tau;
/* apply the transformation to s and extend the spike in w. */
l = jj;
i__2 = *m;
for (i__ = j; i__ <= i__2; ++i__) {
temp = cos__ * s[l] - sin__ * w[i__];
w[i__] = sin__ * s[l] + cos__ * w[i__];
s[l] = temp;
++l;
/* L40: */
}
L50:
/* L60: */
;
}
L70:
/* add the spike from the rank 1 update to w. */
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
w[i__] += v[*n] * u[i__];
/* L80: */
}
/* eliminate the spike. */
*sing = FALSE_;
if (nm1 < 1) {
goto L140;
}
i__1 = nm1;
for (j = 1; j <= i__1; ++j) {
if (w[j] == 0.) {
goto L120;
}
/* determine a givens rotation which eliminates the */
/* j-th element of the spike. */
if ((d__1 = s[jj], abs(d__1)) >= (d__2 = w[j], abs(d__2))) {
goto L90;
}
cotan = s[jj] / w[j];
/* Computing 2nd power */
d__1 = cotan;
sin__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
cos__ = sin__ * cotan;
tau = 1.;
if (abs(cos__) * giant > 1.) {
tau = 1. / cos__;
}
goto L100;
L90:
tan__ = w[j] / s[jj];
/* Computing 2nd power */
d__1 = tan__;
cos__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
sin__ = cos__ * tan__;
tau = sin__;
L100:
/* apply the transformation to s and reduce the spike in w. */
l = jj;
i__2 = *m;
for (i__ = j; i__ <= i__2; ++i__) {
temp = cos__ * s[l] + sin__ * w[i__];
w[i__] = -sin__ * s[l] + cos__ * w[i__];
s[l] = temp;
++l;
/* L110: */
}
/* store the information necessary to recover the */
/* givens rotation. */
w[j] = tau;
L120:
/* test for zero diagonal elements in the output s. */
if (s[jj] == 0.) {
*sing = TRUE_;
}
jj += *m - j + 1;
/* L130: */
}
L140:
/* move w back into the last column of the output s. */
l = jj;
i__1 = *m;
for (i__ = *n; i__ <= i__1; ++i__) {
s[l] = w[i__];
++l;
/* L150: */
}
if (s[jj] == 0.) {
*sing = TRUE_;
}
return;
/* last card of subroutine r1updt. */
} /* r1updt_ */

View File

@ -1,15 +0,0 @@
====== readme for minpack ======
Minpack includes software for solving nonlinear equations and
nonlinear least squares problems. Five algorithmic paths each include
a core subroutine and an easy-to-use driver. The algorithms proceed
either from an analytic specification of the Jacobian matrix or
directly from the problem functions. The paths include facilities for
systems of equations with a banded Jacobian matrix, for least squares
problems with a large amount of data, and for checking the consistency
of the Jacobian matrix with the functions.
This directory contains the double-precision versions.
Jorge More', Burt Garbow, and Ken Hillstrom at Argonne National Laboratory.

View File

@ -1,141 +0,0 @@
/* rwupdt.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "cminpack.h"
#include <math.h>
#include "cminpackP.h"
__cminpack_attr__
void __cminpack_func__(rwupdt)(int n, real *r, int ldr,
const real *w, real *b, real *alpha, real *cos,
real *sin)
{
/* Initialized data */
#define p5 .5
#define p25 .25
/* System generated locals */
int r_dim1, r_offset;
/* Local variables */
int i, j, jm1;
real tan, temp, rowj, cotan;
/* ********** */
/* subroutine rwupdt */
/* given an n by n upper triangular matrix r, this subroutine */
/* computes the qr decomposition of the matrix formed when a row */
/* is added to r. if the row is specified by the vector w, then */
/* rwupdt determines an orthogonal matrix q such that when the */
/* n+1 by n matrix composed of r augmented by w is premultiplied */
/* by (q transpose), the resulting matrix is upper trapezoidal. */
/* the matrix (q transpose) is the product of n transformations */
/* g(n)*g(n-1)* ... *g(1) */
/* where g(i) is a givens rotation in the (i,n+1) plane which */
/* eliminates elements in the (n+1)-st plane. rwupdt also */
/* computes the product (q transpose)*c where c is the */
/* (n+1)-vector (b,alpha). q itself is not accumulated, rather */
/* the information to recover the g rotations is supplied. */
/* the subroutine statement is */
/* subroutine rwupdt(n,r,ldr,w,b,alpha,cos,sin) */
/* where */
/* n is a positive integer input variable set to the order of r. */
/* r is an n by n array. on input the upper triangular part of */
/* r must contain the matrix to be updated. on output r */
/* contains the updated triangular matrix. */
/* ldr is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array r. */
/* w is an input array of length n which must contain the row */
/* vector to be added to r. */
/* b is an array of length n. on input b must contain the */
/* first n elements of the vector c. on output b contains */
/* the first n elements of the vector (q transpose)*c. */
/* alpha is a variable. on input alpha must contain the */
/* (n+1)-st element of the vector c. on output alpha contains */
/* the (n+1)-st element of the vector (q transpose)*c. */
/* cos is an output array of length n which contains the */
/* cosines of the transforming givens rotations. */
/* sin is an output array of length n which contains the */
/* sines of the transforming givens rotations. */
/* subprograms called */
/* fortran-supplied ... dabs,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
/* jorge j. more */
/* ********** */
/* Parameter adjustments */
--sin;
--cos;
--b;
--w;
r_dim1 = ldr;
r_offset = 1 + r_dim1 * 1;
r -= r_offset;
/* Function Body */
for (j = 1; j <= n; ++j) {
rowj = w[j];
jm1 = j - 1;
/* apply the previous transformations to */
/* r(i,j), i=1,2,...,j-1, and to w(j). */
if (jm1 >= 1) {
for (i = 1; i <= jm1; ++i) {
temp = cos[i] * r[i + j * r_dim1] + sin[i] * rowj;
rowj = -sin[i] * r[i + j * r_dim1] + cos[i] * rowj;
r[i + j * r_dim1] = temp;
}
}
/* determine a givens rotation which eliminates w(j). */
cos[j] = 1.;
sin[j] = 0.;
if (rowj != 0.) {
if (fabs(r[j + j * r_dim1]) < fabs(rowj)) {
cotan = r[j + j * r_dim1] / rowj;
sin[j] = p5 / sqrt(p25 + p25 * (cotan * cotan));
cos[j] = sin[j] * cotan;
} else {
tan = rowj / r[j + j * r_dim1];
cos[j] = p5 / sqrt(p25 + p25 * (tan * tan));
sin[j] = cos[j] * tan;
}
/* apply the current transformation to r(j,j), b(j), and alpha. */
r[j + j * r_dim1] = cos[j] * r[j + j * r_dim1] + sin[j] * rowj;
temp = cos[j] * b[j] + sin[j] * *alpha;
*alpha = -sin[j] * b[j] + cos[j] * *alpha;
b[j] = temp;
}
}
/* last card of subroutine rwupdt. */
} /* rwupdt_ */

View File

@ -1,161 +0,0 @@
/* rwupdt.f -- translated by f2c (version 20020621).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "minpack.h"
#include <math.h>
#include "minpackP.h"
__minpack_attr__
void __minpack_func__(rwupdt)(const int *n, real *r__, const int *ldr,
const real *w, real *b, real *alpha, real *cos__,
real *sin__)
{
/* Initialized data */
#define p5 .5
#define p25 .25
/* System generated locals */
int r_dim1, r_offset, i__1, i__2;
real d__1;
/* Local variables */
int i__, j, jm1;
real tan__, temp, rowj, cotan;
/* ********** */
/* subroutine rwupdt */
/* given an n by n upper triangular matrix r, this subroutine */
/* computes the qr decomposition of the matrix formed when a row */
/* is added to r. if the row is specified by the vector w, then */
/* rwupdt determines an orthogonal matrix q such that when the */
/* n+1 by n matrix composed of r augmented by w is premultiplied */
/* by (q transpose), the resulting matrix is upper trapezoidal. */
/* the matrix (q transpose) is the product of n transformations */
/* g(n)*g(n-1)* ... *g(1) */
/* where g(i) is a givens rotation in the (i,n+1) plane which */
/* eliminates elements in the (n+1)-st plane. rwupdt also */
/* computes the product (q transpose)*c where c is the */
/* (n+1)-vector (b,alpha). q itself is not accumulated, rather */
/* the information to recover the g rotations is supplied. */
/* the subroutine statement is */
/* subroutine rwupdt(n,r,ldr,w,b,alpha,cos,sin) */
/* where */
/* n is a positive integer input variable set to the order of r. */
/* r is an n by n array. on input the upper triangular part of */
/* r must contain the matrix to be updated. on output r */
/* contains the updated triangular matrix. */
/* ldr is a positive integer input variable not less than n */
/* which specifies the leading dimension of the array r. */
/* w is an input array of length n which must contain the row */
/* vector to be added to r. */
/* b is an array of length n. on input b must contain the */
/* first n elements of the vector c. on output b contains */
/* the first n elements of the vector (q transpose)*c. */
/* alpha is a variable. on input alpha must contain the */
/* (n+1)-st element of the vector c. on output alpha contains */
/* the (n+1)-st element of the vector (q transpose)*c. */
/* cos is an output array of length n which contains the */
/* cosines of the transforming givens rotations. */
/* sin is an output array of length n which contains the */
/* sines of the transforming givens rotations. */
/* subprograms called */
/* fortran-supplied ... dabs,dsqrt */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
/* jorge j. more */
/* ********** */
/* Parameter adjustments */
--sin__;
--cos__;
--b;
--w;
r_dim1 = *ldr;
r_offset = 1 + r_dim1 * 1;
r__ -= r_offset;
/* Function Body */
i__1 = *n;
for (j = 1; j <= i__1; ++j) {
rowj = w[j];
jm1 = j - 1;
/* apply the previous transformations to */
/* r(i,j), i=1,2,...,j-1, and to w(j). */
if (jm1 < 1) {
goto L20;
}
i__2 = jm1;
for (i__ = 1; i__ <= i__2; ++i__) {
temp = cos__[i__] * r__[i__ + j * r_dim1] + sin__[i__] * rowj;
rowj = -sin__[i__] * r__[i__ + j * r_dim1] + cos__[i__] * rowj;
r__[i__ + j * r_dim1] = temp;
/* L10: */
}
L20:
/* determine a givens rotation which eliminates w(j). */
cos__[j] = 1.;
sin__[j] = 0.;
if (rowj == 0.) {
goto L50;
}
if ((d__1 = r__[j + j * r_dim1], abs(d__1)) >= abs(rowj)) {
goto L30;
}
cotan = r__[j + j * r_dim1] / rowj;
/* Computing 2nd power */
d__1 = cotan;
sin__[j] = p5 / sqrt(p25 + p25 * (d__1 * d__1));
cos__[j] = sin__[j] * cotan;
goto L40;
L30:
tan__ = rowj / r__[j + j * r_dim1];
/* Computing 2nd power */
d__1 = tan__;
cos__[j] = p5 / sqrt(p25 + p25 * (d__1 * d__1));
sin__[j] = cos__[j] * tan__;
L40:
/* apply the current transformation to r(j,j), b(j), and alpha. */
r__[j + j * r_dim1] = cos__[j] * r__[j + j * r_dim1] + sin__[j] *
rowj;
temp = cos__[j] * b[j] + sin__[j] * *alpha;
*alpha = -sin__[j] * b[j] + cos__[j] * *alpha;
b[j] = temp;
L50:
/* L60: */
;
}
return;
/* last card of subroutine rwupdt. */
} /* rwupdt_ */

View File

@ -1,5 +0,0 @@
add_subdirectory(core)
add_subdirectory(fileio)
add_subdirectory(util)
add_subdirectory(algo)
add_subdirectory(viewer)

View File

@ -1,27 +0,0 @@
cmake_minimum_required(VERSION 3.1)
get_filename_component(MODULE_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
set(PROJECT_NAME easy3d_${MODULE_NAME})
project(${PROJECT_NAME})
set(${PROJECT_NAME}_HEADERS
remove_duplication.h
)
set(${PROJECT_NAME}_SOURCES
remove_duplication.cpp
)
add_library(${PROJECT_NAME} STATIC ${${PROJECT_NAME}_SOURCES} ${${PROJECT_NAME}_HEADERS})
set_target_properties(${PROJECT_NAME} PROPERTIES FOLDER "3rd_party/easy3d")
target_include_directories(${PROJECT_NAME} PRIVATE ${ADTREE_easy3d_INCLUDE_DIR})
target_link_libraries(${PROJECT_NAME} easy3d_core easy3d_util)
if (MSVC)
target_compile_definitions(${PROJECT_NAME} PRIVATE _CRT_SECURE_NO_DEPRECATE)
endif ()

View File

@ -1,68 +0,0 @@
/**
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include <easy3d/algo/remove_duplication.h>
#include <cassert>
#include <easy3d/core/point_cloud.h>
#include <3rd_party/kd_tree/Vector3D.h>
#include <3rd_party/kd_tree/KdTree.h>
namespace easy3d {
std::vector<PointCloud::Vertex> RemoveDuplication::apply(PointCloud *cloud, float epsilon) {
const int maxBucketSize = 16;
std::vector<vec3>& points = cloud->points();
float* pointer = points[0];
KdTree kd(reinterpret_cast<Vector3D*>(pointer), points.size(), maxBucketSize);
std::vector<bool> keep(cloud->vertices_size(), true);
double sqr_dist = epsilon * epsilon;
for (std::size_t i = 0; i < points.size(); ++i) {
if (keep[i]) {
const vec3 &p = points[i];
kd.queryRange(Vector3D(p.x, p.y, p.z), sqr_dist, true);
int num = kd.getNOfFoundNeighbours();
if (num > 1) {
for (int j = 1; j < num; ++j) {
int idx = kd.getNeighbourPositionIndex(j);
keep[idx] = 0;
}
}
}
}
std::vector<PointCloud::Vertex> points_to_remove;
for (std::size_t i = 0; i < keep.size(); ++i) {
if (!keep[i])
points_to_remove.push_back(PointCloud::Vertex(i));
}
return points_to_remove;
}
}

View File

@ -1,53 +0,0 @@
/**
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_REMOVE_DUPLICATION_H
#define EASY3D_REMOVE_DUPLICATION_H
#include <vector>
#include <easy3d/core/point_cloud.h>
namespace easy3d {
class RemoveDuplication {
public:
/**
* Remove duplicated points of a point clouds.
* @param cloud The point cloud.
* @param epsilon The distance threshold. Points with a distance smaller than this value will be considered
* as having duplications.
* @return The vertices that should to deleted.
*/
static std::vector<PointCloud::Vertex> apply(PointCloud *cloud, float epsilon);
};
} // namespace easy3d
#endif // EASY3D_REMOVE_DUPLICATION_H

View File

@ -1,41 +0,0 @@
cmake_minimum_required(VERSION 3.1)
get_filename_component(MODULE_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
set(PROJECT_NAME easy3d_${MODULE_NAME})
project(${PROJECT_NAME})
set(${PROJECT_NAME}_HEADERS
box.h
constant.h
eigen_solver.h
graph.h
line.h
mat.h
plane.h
point_cloud.h
principal_axes.h
properties.h
quat.h
random.h
rect.h
segment.h
surface_mesh.h
types.h
vec.h
)
set(${PROJECT_NAME}_SOURCES
graph.cpp
point_cloud.cpp
surface_mesh.cpp
)
add_library(${PROJECT_NAME} STATIC ${${PROJECT_NAME}_SOURCES} ${${PROJECT_NAME}_HEADERS} )
set_target_properties(${PROJECT_NAME} PROPERTIES FOLDER "3rd_party/easy3d")
target_include_directories(${PROJECT_NAME} PRIVATE ${ADTREE_easy3d_INCLUDE_DIR})

View File

@ -1,176 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_GENERIC_BOX_H
#define EASY3D_GENERIC_BOX_H
#include <cassert>
#include <algorithm>
#include <limits>
#include <easy3d/core/vec.h>
namespace easy3d {
template <int DIM, typename FT>
class GenericBox {
public:
typedef Vec<DIM, FT> Point;
typedef Vec<DIM, FT> Vector;
typedef GenericBox<DIM, FT> thisclass;
public:
GenericBox()
: min_(std::numeric_limits<FT>::max()) // initialized to an invalid value
, max_(-std::numeric_limits<FT>::max())
{
}
// defined by the diagonal corners
GenericBox(const Point& pmin, const Point& pmax)
{
// the user might provide wrong order
// min_ = pmin;
// max_ = pmax;
add_point(pmin);
add_point(pmax);
}
// defined by center and radius
GenericBox(const Point& c, FT r) {
Vector dir(1.0);
dir.normalize();
min_ = c - dir * r;
max_ = c + dir * r;
}
inline bool initialized() const {
return max_.x >= min_.x - std::numeric_limits<FT>::epsilon();
}
inline void clear() {
min_ = Point(std::numeric_limits<FT>::max());
max_ = Point(-std::numeric_limits<FT>::max());
}
inline Point min() const {
if (initialized())
return min_;
else
return Point(FT(0.0));
}
inline Point max() const {
if (initialized())
return max_;
else
return Point(FT(0.0));
}
inline FT min(unsigned int axis) const {
assert(axis >= 0 && axis < DIM);
if (initialized())
return min_[axis];
else
return FT(0.0);
}
inline FT max(unsigned int axis) const {
assert(axis >= 0 && axis < DIM);
if (initialized())
return max_[axis];
else
return FT(0.0);
}
inline FT range(unsigned int axis) const {
assert(axis >= 0 && axis < DIM);
if (initialized())
return max_[axis] - min_[axis];
else
return FT(0.0);
}
inline Point center() const {
if (initialized())
return FT(0.5) * (min_ + max_);
else
return Point(0.0);
}
inline FT diagonal() const {
if (initialized()) {
FT sqr_len(0.0);
for (int i=0; i<DIM; ++i) {
FT d = max_[i] - min_[i];
sqr_len += d * d;
}
return std::sqrt(sqr_len);
}
else
return FT(0.0);
}
inline void add_point(const Point& p) {
if (initialized()) {
for (int i=0; i<DIM; ++i) {
min_[i] = std::min(min_[i], p[i]);
max_[i] = std::max(max_[i], p[i]);
}
}
else {
min_ = p;
max_ = p;
}
}
inline void add_box(const thisclass& b) {
add_point(b.min());
add_point(b.max());
}
inline thisclass operator+(const thisclass& b) const {
thisclass result = *this;
result += b;
return result;
}
inline thisclass& operator+=(const thisclass& b) {
add_point(b.min());
add_point(b.max());
return *this;
}
private:
Point min_;
Point max_;
};
} // namespace easy3d
#endif // EASY3D_GENERIC_BOX_H

View File

@ -1,69 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_CONSTANT_H
#define EASY3D_CONSTANT_H
#include <cfloat>
#include <climits>
namespace easy3d {
#ifndef M_PI
#define M_PI 3.14159265358979323846264338327950288419716939937510582 // pi
#endif
#define half_pi M_PI * 0.5
#define quarter_pi M_PI * 0.25
#define two_pi M_PI * 2.0
#define rad2deg(a) ((a) * 180.0 / M_PI)
#define deg2rad(a) ((a) * M_PI / 180.0)
// Function returning min/max for corresponding type
template <typename FT> inline FT min();
template <typename FT> inline FT max();
// Template specializations for float and double
template <> inline int min<int>() { return INT_MIN; }
template <> inline int max<int>() { return INT_MAX; }
template <> inline float min<float>() { return FLT_MIN; }
template <> inline float max<float>() { return FLT_MAX; }
template <> inline double min<double>() { return DBL_MIN; }
template <> inline double max<double>() { return DBL_MAX; }
// standard epsilon values
// Function returning epsilon for corresponding type
template <typename FT> inline FT epsilon();
template <typename FT> inline FT epsilon_sqr();
// Template specializations for float and double
template <> inline float epsilon<float>() { return 1.0e-6f; }
template <> inline float epsilon_sqr<float>() { return 1.0e-12f; }
template <> inline double epsilon<double>() { return 1.0e-12; }
template <> inline double epsilon_sqr<double>() { return 1.0e-24; }
}
#endif // EASY3D_CONSTANT_H

View File

@ -1,630 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
/** ----------------------------------------------------------
* The code is adapted from Magic Software with significant
* modifications and enhancement.
* Magic Software, Inc.
* http://www.magic-software.com
* Copyright(c) 2000, 2001. All Rights Reserved
* Source code from Magic Software is supplied under the
* terms of a license agreement and may not be copied or
* disclosed except in accordance with the terms of that
* agreement. The various license agreements may be found
* at the Magic Software web site. This file is subject
* to the license
* FREE SOURCE CODE
* http://www.magic-software.com/License/free.pdf
*----------------------------------------------------------*/
#ifndef EASY3D_EIGEN_SOLVER_H
#define EASY3D_EIGEN_SOLVER_H
#include <cmath>
#include <cassert>
namespace easy3d {
template <typename FT>
class EigenSolver
{
public:
enum SortingMethod { NO_SORTING, INCREASING, DECREASING };
public:
/// @param n: the size of the input matrix
EigenSolver(int n);
~EigenSolver();
/// solve
/// @param mat: the input matrix (row major 2D array)
void solve(FT** mat, SortingMethod sm = NO_SORTING);
/// the i_th eigenvalue
FT eigen_value(int i) const { return diag_[i]; }
/// the comp_th component of the i_th eigenvector
FT eigen_vector(int comp, int i) const { return matrix_[comp][i]; }
/// the eigenvalues
FT* eigen_values() { return diag_; }
/// the eigenvectors (stored as the columns of the returned matrix)
FT** eigen_vectors() { return matrix_; }
protected:
int size_;
FT** matrix_;
FT* diag_;
FT* subd_;
private:
// Householder reduction to tridiagonal form
static void tridiagonal_2(FT** mat, FT* diag, FT* subd);
static void tridiagonal_3(FT** mat, FT* diag, FT* subd);
static void tridiagonal_4(FT** mat, FT* diag, FT* subd);
static void tridiagonal_n(int n, FT** mat, FT* diag, FT* subd);
// QL algorithm with implicit shifting, applies to tridiagonal matrices
static bool ql_algorithm(int n, FT* diag, FT* subd, FT** mat);
// sort eigenvalues and eigenvectors in the descending order
static void decreasing_sort(int n, FT* eigval, FT** eigvec);
// sort eigenvalues and eigenvectors in the ascending order
static void increasing_sort(int n, FT* eigval, FT** eigvec);
};
//----------------------------------------------------------------------------
template <typename FT>
EigenSolver<FT>::EigenSolver(int n)
{
assert( n >= 2 );
size_ = n;
matrix_ = nullptr;
diag_ = new FT[size_];
subd_ = new FT[size_];
}
template <typename FT>
EigenSolver<FT>::~EigenSolver()
{
delete[] subd_;
delete[] diag_;
}
template <typename FT>
inline void EigenSolver<FT>::tridiagonal_2(FT** matrix_, FT* diag_, FT* subd_)
{
// matrix is already tridiagonal
diag_[0] = matrix_[0][0];
diag_[1] = matrix_[1][1];
subd_[0] = matrix_[0][1];
subd_[1] = 0.0f;
matrix_[0][0] = 1.0f;
matrix_[0][1] = 0.0f;
matrix_[1][0] = 0.0f;
matrix_[1][1] = 1.0f;
}
template <typename FT>
inline void EigenSolver<FT>::tridiagonal_3(FT** matrix_, FT* diag_, FT* subd_)
{
FT fM00 = matrix_[0][0];
FT fM01 = matrix_[0][1];
FT fM02 = matrix_[0][2];
FT fM11 = matrix_[1][1];
FT fM12 = matrix_[1][2];
FT fM22 = matrix_[2][2];
diag_[0] = fM00;
subd_[2] = 0.0f;
if( fM02 != 0.0f )
{
FT fLength = std::sqrt(fM01*fM01+fM02*fM02);
FT fInvLength = 1.0f/fLength;
fM01 *= fInvLength;
fM02 *= fInvLength;
FT fQ = 2.0f*fM01*fM12+fM02*(fM22-fM11);
diag_[1] = fM11+fM02*fQ;
diag_[2] = fM22-fM02*fQ;
subd_[0] = fLength;
subd_[1] = fM12-fM01*fQ;
matrix_[0][0] = 1.0f; matrix_[0][1] = 0.0f; matrix_[0][2] = 0.0f;
matrix_[1][0] = 0.0f; matrix_[1][1] = fM01; matrix_[1][2] = fM02;
matrix_[2][0] = 0.0f; matrix_[2][1] = fM02; matrix_[2][2] = -fM01;
}
else
{
diag_[1] = fM11;
diag_[2] = fM22;
subd_[0] = fM01;
subd_[1] = fM12;
matrix_[0][0] = 1.0f; matrix_[0][1] = 0.0f; matrix_[0][2] = 0.0f;
matrix_[1][0] = 0.0f; matrix_[1][1] = 1.0f; matrix_[1][2] = 0.0f;
matrix_[2][0] = 0.0f; matrix_[2][1] = 0.0f; matrix_[2][2] = 1.0f;
}
}
template <typename FT>
inline void EigenSolver<FT>::tridiagonal_4(FT** matrix_, FT* diag_, FT* subd_)
{
// save matrix M
FT fM00 = matrix_[0][0];
FT fM01 = matrix_[0][1];
FT fM02 = matrix_[0][2];
FT fM03 = matrix_[0][3];
FT fM11 = matrix_[1][1];
FT fM12 = matrix_[1][2];
FT fM13 = matrix_[1][3];
FT fM22 = matrix_[2][2];
FT fM23 = matrix_[2][3];
FT fM33 = matrix_[3][3];
diag_[0] = fM00;
subd_[3] = 0.0f;
matrix_[0][0] = 1.0f;
matrix_[0][1] = 0.0f;
matrix_[0][2] = 0.0f;
matrix_[0][3] = 0.0f;
matrix_[1][0] = 0.0f;
matrix_[2][0] = 0.0f;
matrix_[3][0] = 0.0f;
FT fLength, fInvLength;
if( fM02 != 0.0f || fM03 != 0.0f )
{
FT fQ11, fQ12, fQ13;
FT fQ21, fQ22, fQ23;
FT fQ31, fQ32, fQ33;
// build column Q1
fLength = std::sqrt(fM01*fM01+fM02*fM02+fM03*fM03);
fInvLength = 1.0f/fLength;
fQ11 = fM01*fInvLength;
fQ21 = fM02*fInvLength;
fQ31 = fM03*fInvLength;
subd_[0] = fLength;
// compute S*Q1
FT fV0 = fM11*fQ11+fM12*fQ21+fM13*fQ31;
FT fV1 = fM12*fQ11+fM22*fQ21+fM23*fQ31;
FT fV2 = fM13*fQ11+fM23*fQ21+fM33*fQ31;
diag_[1] = fQ11*fV0+fQ21*fV1+fQ31*fV2;
// build column Q3 = Q1x(S*Q1)
fQ13 = fQ21*fV2-fQ31*fV1;
fQ23 = fQ31*fV0-fQ11*fV2;
fQ33 = fQ11*fV1-fQ21*fV0;
fLength = std::sqrt(fQ13*fQ13+fQ23*fQ23+fQ33*fQ33);
if( fLength > 0.0f )
{
fInvLength = 1.0f/fLength;
fQ13 *= fInvLength;
fQ23 *= fInvLength;
fQ33 *= fInvLength;
// build column Q2 = Q3xQ1
fQ12 = fQ23*fQ31-fQ33*fQ21;
fQ22 = fQ33*fQ11-fQ13*fQ31;
fQ32 = fQ13*fQ21-fQ23*fQ11;
fV0 = fQ12*fM11+fQ22*fM12+fQ32*fM13;
fV1 = fQ12*fM12+fQ22*fM22+fQ32*fM23;
fV2 = fQ12*fM13+fQ22*fM23+fQ32*fM33;
subd_[1] = fQ11*fV0+fQ21*fV1+fQ31*fV2;
diag_[2] = fQ12*fV0+fQ22*fV1+fQ32*fV2;
subd_[2] = fQ13*fV0+fQ23*fV1+fQ33*fV2;
fV0 = fQ13*fM11+fQ23*fM12+fQ33*fM13;
fV1 = fQ13*fM12+fQ23*fM22+fQ33*fM23;
fV2 = fQ13*fM13+fQ23*fM23+fQ33*fM33;
diag_[3] = fQ13*fV0+fQ23*fV1+fQ33*fV2;
}
else
{
// S*Q1 parallel to Q1, choose any valid Q2 and Q3
subd_[1] = 0.0f;
fLength = fQ21*fQ21+fQ31*fQ31;
if( fLength > 0.0f )
{
fInvLength = 1.0f/fLength;
FT fTmp = fQ11-1.0f;
fQ12 = -fQ21;
fQ22 = 1.0f+fTmp*fQ21*fQ21*fInvLength;
fQ32 = fTmp*fQ21*fQ31*fInvLength;
fQ13 = -fQ31;
fQ23 = fQ32;
fQ33 = 1.0f+fTmp*fQ31*fQ31*fInvLength;
fV0 = fQ12*fM11+fQ22*fM12+fQ32*fM13;
fV1 = fQ12*fM12+fQ22*fM22+fQ32*fM23;
fV2 = fQ12*fM13+fQ22*fM23+fQ32*fM33;
diag_[2] = fQ12*fV0+fQ22*fV1+fQ32*fV2;
subd_[2] = fQ13*fV0+fQ23*fV1+fQ33*fV2;
fV0 = fQ13*fM11+fQ23*fM12+fQ33*fM13;
fV1 = fQ13*fM12+fQ23*fM22+fQ33*fM23;
fV2 = fQ13*fM13+fQ23*fM23+fQ33*fM33;
diag_[3] = fQ13*fV0+fQ23*fV1+fQ33*fV2;
}
else
{
// Q1 =(+-1,0,0)
fQ12 = 0.0f; fQ22 = 1.0f; fQ32 = 0.0f;
fQ13 = 0.0f; fQ23 = 0.0f; fQ33 = 1.0f;
diag_[2] = fM22;
diag_[3] = fM33;
subd_[2] = fM23;
}
}
matrix_[1][1] = fQ11; matrix_[1][2] = fQ12; matrix_[1][3] = fQ13;
matrix_[2][1] = fQ21; matrix_[2][2] = fQ22; matrix_[2][3] = fQ23;
matrix_[3][1] = fQ31; matrix_[3][2] = fQ32; matrix_[3][3] = fQ33;
}
else
{
diag_[1] = fM11;
subd_[0] = fM01;
matrix_[1][1] = 1.0f;
matrix_[2][1] = 0.0f;
matrix_[3][1] = 0.0f;
if( fM13 != 0.0f )
{
fLength = std::sqrt(fM12*fM12+fM13*fM13);
fInvLength = 1.0f/fLength;
fM12 *= fInvLength;
fM13 *= fInvLength;
FT fQ = 2.0f*fM12*fM23+fM13*(fM33-fM22);
diag_[2] = fM22+fM13*fQ;
diag_[3] = fM33-fM13*fQ;
subd_[1] = fLength;
subd_[2] = fM23-fM12*fQ;
matrix_[1][2] = 0.0f;
matrix_[1][3] = 0.0f;
matrix_[2][2] = fM12;
matrix_[2][3] = fM13;
matrix_[3][2] = fM13;
matrix_[3][3] = -fM12;
}
else
{
diag_[2] = fM22;
diag_[3] = fM33;
subd_[1] = fM12;
subd_[2] = fM23;
matrix_[1][2] = 0.0f;
matrix_[1][3] = 0.0f;
matrix_[2][2] = 1.0f;
matrix_[2][3] = 0.0f;
matrix_[3][2] = 0.0f;
matrix_[3][3] = 1.0f;
}
}
}
template <typename FT>
inline void EigenSolver<FT>::tridiagonal_n(int n, FT** matrix_, FT* diag_, FT* subd_)
{
int i0, i1, i2, i3;
for(i0 = n-1, i3 = n-2; i0 >= 1; i0--, i3--)
{
FT fH = 0.0f, fScale = 0.0f;
if( i3 > 0 )
{
for(i2 = 0; i2 <= i3; i2++)
fScale += std::abs(matrix_[i0][i2]);
if( fScale == 0 )
{
subd_[i0] = matrix_[i0][i3];
}
else
{
FT fInvScale = 1.0f/fScale;
for(i2 = 0; i2 <= i3; i2++)
{
matrix_[i0][i2] *= fInvScale;
fH += matrix_[i0][i2]*matrix_[i0][i2];
}
FT fF = matrix_[i0][i3];
FT fG = std::sqrt(fH);
if( fF > 0.0f )
fG = -fG;
subd_[i0] = fScale*fG;
fH -= fF*fG;
matrix_[i0][i3] = fF-fG;
fF = 0.0f;
FT fInvH = 1.0f/fH;
for(i1 = 0; i1 <= i3; i1++)
{
matrix_[i1][i0] = matrix_[i0][i1]*fInvH;
fG = 0.0f;
for(i2 = 0; i2 <= i1; i2++)
fG += matrix_[i1][i2]*matrix_[i0][i2];
for(i2 = i1+1; i2 <= i3; i2++)
fG += matrix_[i2][i1]*matrix_[i0][i2];
subd_[i1] = fG*fInvH;
fF += subd_[i1]*matrix_[i0][i1];
}
FT fHalfFdivH = 0.5f*fF*fInvH;
for(i1 = 0; i1 <= i3; i1++)
{
fF = matrix_[i0][i1];
fG = subd_[i1] - fHalfFdivH*fF;
subd_[i1] = fG;
for(i2 = 0; i2 <= i1; i2++)
{
matrix_[i1][i2] -= fF*subd_[i2] +
fG*matrix_[i0][i2];
}
}
}
}
else
{
subd_[i0] = matrix_[i0][i3];
}
diag_[i0] = fH;
}
diag_[0] = 0.0f;
subd_[0] = 0.0f;
for(i0 = 0, i3 = -1; i0 <= n-1; i0++, i3++)
{
if( diag_[i0] )
{
for(i1 = 0; i1 <= i3; i1++)
{
FT fSum = 0.0f;
for(i2 = 0; i2 <= i3; i2++)
fSum += matrix_[i0][i2]*matrix_[i2][i1];
for(i2 = 0; i2 <= i3; i2++)
matrix_[i2][i1] -= fSum*matrix_[i2][i0];
}
}
diag_[i0] = matrix_[i0][i0];
matrix_[i0][i0] = 1.0f;
for(i1 = 0; i1 <= i3; i1++)
{
matrix_[i1][i0] = 0.0f;
matrix_[i0][i1] = 0.0f;
}
}
// re-ordering if Eigen<FT>::ql_algorithm is used subsequently
for(i0 = 1, i3 = 0; i0 < n; i0++, i3++)
subd_[i3] = subd_[i0];
subd_[n-1] = 0.0f;
}
template <typename FT>
inline bool EigenSolver<FT>::ql_algorithm(int n, FT* diag_, FT* subd_, FT** matrix_)
{
const int iMaxIter = 32;
for(int i0 = 0; i0 < n; i0++)
{
int i1;
for(i1 = 0; i1 < iMaxIter; i1++)
{
int i2;
for(i2 = i0; i2 <= n-2; i2++)
{
FT fTmp = std::abs(diag_[i2]) +
std::abs(diag_[i2+1]);
if( std::abs(subd_[i2]) + fTmp == fTmp )
break;
}
if( i2 == i0 )
break;
FT fG =(diag_[i0+1]-diag_[i0])/(2.0f*subd_[i0]);
FT fR = std::sqrt(fG*fG+1.0f);
if( fG < 0.0f )
fG = diag_[i2]-diag_[i0]+subd_[i0]/(fG-fR);
else
fG = diag_[i2]-diag_[i0]+subd_[i0]/(fG+fR);
FT fSin = 1.0f, fCos = 1.0, fP = 0.0f;
for(int i3 = i2-1; i3 >= i0; i3--)
{
FT fF = fSin*subd_[i3];
FT fB = fCos*subd_[i3];
if( std::abs(fF) >= std::abs(fG) )
{
fCos = fG/fF;
fR = std::sqrt(fCos*fCos+1.0f);
subd_[i3+1] = fF*fR;
fSin = 1.0f/fR;
fCos *= fSin;
}
else
{
fSin = fF/fG;
fR = std::sqrt(fSin*fSin+1.0f);
subd_[i3+1] = fG*fR;
fCos = 1.0f/fR;
fSin *= fCos;
}
fG = diag_[i3+1]-fP;
fR =(diag_[i3]-fG)*fSin+2.0f*fB*fCos;
fP = fSin*fR;
diag_[i3+1] = fG+fP;
fG = fCos*fR-fB;
for(int i4 = 0; i4 < n; i4++)
{
fF = matrix_[i4][i3+1];
matrix_[i4][i3+1] = fSin*matrix_[i4][i3]+fCos*fF;
matrix_[i4][i3] = fCos*matrix_[i4][i3]-fSin*fF;
}
}
diag_[i0] -= fP;
subd_[i0] = fG;
subd_[i2] = 0.0f;
}
if( i1 == iMaxIter )
return false;
}
return true;
}
template <typename FT>
inline void EigenSolver<FT>::decreasing_sort(int n, FT* eigval, FT** eigvec)
{
// sort eigenvalues in decreasing order, e[0] >= ... >= e[n-1]
for(int i0 = 0, i1; i0 <= n-2; i0++)
{
// locate maximum eigenvalue
i1 = i0;
FT fMax = eigval[i1];
int i2;
for(i2 = i0+1; i2 < n; i2++)
{
if( eigval[i2] > fMax )
{
i1 = i2;
fMax = eigval[i1];
}
}
if( i1 != i0 )
{
// swap eigenvalues
eigval[i1] = eigval[i0];
eigval[i0] = fMax;
// swap eigenvectors
for(i2 = 0; i2 < n; i2++)
{
FT fTmp = eigvec[i2][i0];
eigvec[i2][i0] = eigvec[i2][i1];
eigvec[i2][i1] = fTmp;
}
}
}
}
template <typename FT>
inline void EigenSolver<FT>::increasing_sort(int n, FT* eigval, FT** eigvec)
{
// sort eigenvalues in increasing order, e[0] <= ... <= e[n-1]
for(int i0 = 0, i1; i0 <= n-2; i0++)
{
// locate minimum eigenvalue
i1 = i0;
FT fMin = eigval[i1];
int i2;
for(i2 = i0+1; i2 < n; i2++)
{
if( eigval[i2] < fMin )
{
i1 = i2;
fMin = eigval[i1];
}
}
if( i1 != i0 )
{
// swap eigenvalues
eigval[i1] = eigval[i0];
eigval[i0] = fMin;
// swap eigenvectors
for(i2 = 0; i2 < n; i2++)
{
FT fTmp = eigvec[i2][i0];
eigvec[i2][i0] = eigvec[i2][i1];
eigvec[i2][i1] = fTmp;
}
}
}
}
template <typename FT>
inline void EigenSolver<FT>::solve(FT** mat, SortingMethod sm /* = NO_SORTING*/)
{
matrix_ = mat;
switch( size_ )
{
case 2:
tridiagonal_2(matrix_,diag_,subd_);
break;
case 3:
tridiagonal_3(matrix_,diag_,subd_);
break;
case 4:
tridiagonal_4(matrix_,diag_,subd_);
break;
default:
tridiagonal_n(size_,matrix_,diag_,subd_);
break;
}
ql_algorithm(size_,diag_,subd_,matrix_);
switch( sm )
{
case INCREASING:
increasing_sort(size_,diag_,matrix_);
break;
case DECREASING:
decreasing_sort(size_,diag_,matrix_);
break;
default:
break;
}
}
}
#endif // EASY3D_EIGEN_SOLVER_H

View File

@ -1,411 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include <easy3d/core/graph.h>
#include <cmath>
namespace easy3d {
Graph::Graph()
{
// allocate standard properties
// same list is used in operator=() and assign()
vconn_ = add_vertex_property<VertexConnectivity>("v:connectivity");
econn_ = add_edge_property<EdgeConnectivity>("e:connectivity");
vpoint_ = add_vertex_property<vec3>("v:point");
vdeleted_ = add_vertex_property<bool>("v:deleted", false);
edeleted_ = add_edge_property<bool>("e:deleted", false);
mprops_.push_back();
deleted_vertices_ = deleted_edges_ = 0;
garbage_ = false;
}
//-----------------------------------------------------------------------------
Graph::~Graph()
{
}
//-----------------------------------------------------------------------------
Graph& Graph::operator=(const Graph& rhs)
{
if (this != &rhs)
{
// deep copy of property containers
vprops_ = rhs.vprops_;
eprops_ = rhs.eprops_;
mprops_ = rhs.mprops_;
// property handles contain pointers, have to be reassigned
vconn_ = vertex_property<VertexConnectivity>("v:connectivity");
econn_ = edge_property<EdgeConnectivity>("e:connectivity");
vdeleted_ = vertex_property<bool>("v:deleted");
edeleted_ = edge_property<bool>("e:deleted");
vpoint_ = vertex_property<vec3>("v:point");
// how many elements are deleted?
deleted_vertices_ = rhs.deleted_vertices_;
deleted_edges_ = rhs.deleted_edges_;
garbage_ = rhs.garbage_;
}
return *this;
}
//-----------------------------------------------------------------------------
Graph& Graph::assign(const Graph& rhs)
{
if (this != &rhs)
{
// clear properties
vprops_.clear();
eprops_.clear();
mprops_.clear();
// allocate standard properties
vconn_ = add_vertex_property<VertexConnectivity>("v:connectivity");
econn_ = add_edge_property<EdgeConnectivity>("e:connectivity");
vpoint_ = add_vertex_property<vec3>("v:point");
vdeleted_ = add_vertex_property<bool>("v:deleted", false);
edeleted_ = add_edge_property<bool>("e:deleted", false);
// copy properties from other mesh
vconn_.array() = rhs.vconn_.array();
econn_.array() = rhs.econn_.array();
vpoint_.array() = rhs.vpoint_.array();
vdeleted_.array() = rhs.vdeleted_.array();
edeleted_.array() = rhs.edeleted_.array();
// resize (needed by property containers)
vprops_.resize(rhs.vertices_size());
eprops_.resize(rhs.edges_size());
mprops_.resize(1);
// how many elements are deleted?
deleted_vertices_ = rhs.deleted_vertices_;
deleted_edges_ = rhs.deleted_edges_;
garbage_ = rhs.garbage_;
}
return *this;
}
//-----------------------------------------------------------------------------
void Graph::clear()
{
vprops_.resize(0);
eprops_.resize(0);
mprops_.resize(0);
free_memory();
deleted_vertices_ = deleted_edges_ = 0;
garbage_ = false;
}
//-----------------------------------------------------------------------------
void Graph::free_memory()
{
vprops_.free_memory();
eprops_.free_memory();
mprops_.free_memory();
}
//-----------------------------------------------------------------------------
void Graph::reserve(unsigned int nvertices, unsigned int nedges)
{
vprops_.reserve(nvertices);
eprops_.reserve(nedges);
mprops_.reserve(1);
}
//-----------------------------------------------------------------------------
void Graph::property_stats() const
{
std::vector<std::string> props;
std::cout << "vertex properties:\n";
props = vertex_properties();
for (unsigned int i=0; i<props.size(); ++i)
std::cout << "\t" << props[i] << std::endl;
std::cout << "edge properties:\n";
props = edge_properties();
for (unsigned int i=0; i<props.size(); ++i)
std::cout << "\t" << props[i] << std::endl;
std::cout << "model properties:\n";
props = model_properties();
for (unsigned int i = 0; i < props.size(); ++i)
std::cout << "\t" << props[i] << std::endl;
}
//-----------------------------------------------------------------------------
Graph::Vertex Graph:: add_vertex(const vec3& p)
{
Vertex v = new_vertex();
vpoint_[v] = p;
return v;
}
Graph::Edge Graph::add_edge(const Vertex& start, const Vertex& end) {
assert(start != end);
Edge e = new_edge();
econn_[e].source_ = start;
econn_[e].target_ = end;
vconn_[start].edges_.push_back(e);
vconn_[end].edges_.push_back(e);
return e;
}
//-----------------------------------------------------------------------------
Graph::Edge Graph::find_edge(Vertex start, Vertex end) const
{
assert(is_valid(start) && is_valid(end));
for (auto e : edges(start)) {
if (from_vertex(e) == end || to_vertex(e) == end)
return e;
}
return Edge();
}
//-----------------------------------------------------------------------------
unsigned int Graph::valence(Vertex v) const
{
return static_cast<unsigned int>(vconn_[v].edges_.size());
}
//-----------------------------------------------------------------------------
float Graph::edge_length(Edge e) const
{
return norm(vpoint_[from_vertex(e)] - vpoint_[to_vertex(e)]);
}
//-----------------------------------------------------------------------------
void Graph::delete_vertex(Vertex v)
{
// if (vdeleted_[v]) return;
// // collect incident faces
// std::vector<Face> incident_faces;
// incident_faces.reserve(6);
// FaceAroundVertexCirculator fc, fc_end;
// fc = fc_end = faces(v);
// if (fc)
// do
// {
// incident_faces.push_back(*fc);
// } while (++fc != fc_end);
// // delete incident faces
// std::vector<Face>::iterator fit(incident_faces.begin()),
// fend(incident_faces.end());
// for (; fit != fend; ++fit)
// delete_face(*fit);
// // mark v as deleted if not yet done by delete_face()
// if (!vdeleted_[v])
// {
// vdeleted_[v] = true;
// deleted_vertices_++;
// garbage_ = true;
// }
}
//-----------------------------------------------------------------------------
void Graph::delete_edge(Edge e)
{
// if (edeleted_[e]) return;
// Face f0 = face(halfedge(e, 0));
// Face f1 = face(halfedge(e, 1));
// if (f0.is_valid()) delete_face(f0);
// if (f1.is_valid()) delete_face(f1);
}
//-----------------------------------------------------------------------------
void Graph::garbage_collection()
{
// int i, i0, i1,
// nV(vertices_size()),
// nE(edges_size()),
// nH(halfedges_size()),
// Vertex v;
// Halfedge h;
// // setup handle mapping
// VertexProperty<Vertex> vmap = add_vertex_property<Vertex>("v:garbage-collection");
// EdgeProperty<Edge> emap = add_edge_property<Edge>("e:garbage-collection");
// for (i=0; i<nV; ++i)
// vmap[Vertex(i)] = Vertex(i);
// for (i=0; i<nH; ++i)
// emap[Edge(i)] = Edge(i);
// // remove deleted vertices
// if (nV > 0)
// {
// i0=0; i1=nV-1;
// while (1)
// {
// // find first deleted and last un-deleted
// while (!vdeleted_[Vertex(i0)] && i0 < i1) ++i0;
// while ( vdeleted_[Vertex(i1)] && i0 < i1) --i1;
// if (i0 >= i1) break;
// // swap
// vprops_.swap(i0, i1);
// };
// // remember new size
// nV = vdeleted_[Vertex(i0)] ? i0 : i0+1;
// }
// // remove deleted edges
// if (nE > 0)
// {
// i0=0; i1=nE-1;
// while (1)
// {
// // find first deleted and last un-deleted
// while (!edeleted_[Edge(i0)] && i0 < i1) ++i0;
// while ( edeleted_[Edge(i1)] && i0 < i1) --i1;
// if (i0 >= i1) break;
// // swap
// eprops_.swap(i0, i1);
// eprops_.swap(2*i0, 2*i1);
// };
// // remember new size
// nE = edeleted_[Edge(i0)] ? i0 : i0+1;
// nH = 2*nE;
// }
// // update vertex connectivity
// for (i=0; i<nV; ++i)
// {
// v = Vertex(i);
// if (!is_isolated(v))
// set_halfedge(v, hmap[edges(v)]);
// }
// // update halfedge connectivity
// for (i=0; i<nH; ++i)
// {
// h = Halfedge(i);
// set_vertex(h, vmap[to_vertex(h)]);
// set_next_halfedge(h, hmap[next_halfedge(h)]);
// if (!is_boundary(h))
// set_face(h, fmap[face(h)]);
// }
// // remove handle maps
// remove_vertex_property(vmap);
// remove_edge_property(emap);
// // finally resize arrays
// vprops_.resize(nV); vprops_.free_memory();
// eprops_.resize(nH); eprops_.free_memory();
// deleted_vertices_ = deleted_edges_ = 0;
// garbage_ = false;
}
// std::vector<Graph::Vertex> Graph::vertices(Vertex v) const {
// assert(v.is_valid());
// std::vector<Graph::Vertex> result;
// for (auto e : edges(v)) {
// Vertex another = from_vertex(e);
// if (another != v)
// result.push_back(another);
// else
// result.push_back(to_vertex(e));
// }
// return result;
// }
} // namespace easy3d

View File

@ -1,917 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_GRAPH_H
#define EASY3D_GRAPH_H
#include <easy3d/viewer/model.h>
#include <vector>
#include <easy3d/core/types.h>
#include <easy3d/core/properties.h>
namespace easy3d {
/**
* @brief A Graph data structure with easy property management.
*/
class Graph : public Model
{
public: //------------------------------------------------------ topology types
/// Base class for all topology types (internally it is basically an index)
/// \sa Vertex, Edge
class BaseHandle
{
public:
/// constructor
explicit BaseHandle(int _idx = -1) : idx_(_idx) {}
/// Get the underlying index of this handle
int idx() const { return idx_; }
/// reset handle to be invalid (index=-1)
void reset() { idx_ = -1; }
/// return whether the handle is valid, i.e., the index is not equal to -1.
bool is_valid() const { return idx_ != -1; }
/// are two handles equal?
bool operator==(const BaseHandle& _rhs) const {
return idx_ == _rhs.idx_;
}
/// are two handles different?
bool operator!=(const BaseHandle& _rhs) const {
return idx_ != _rhs.idx_;
}
/// compare operator useful for sorting handles
bool operator<(const BaseHandle& _rhs) const {
return idx_ < _rhs.idx_;
}
private:
friend class VertexIterator;
friend class EdgeIterator;
friend class Graph;
int idx_;
};
/// this type represents a vertex (internally it is basically an index)
/// \sa Edge
struct Vertex : public BaseHandle
{
/// default constructor (with invalid index)
explicit Vertex(int _idx = -1) : BaseHandle(_idx) {}
std::ostream& operator<<(std::ostream& os) const { return os << 'v' << idx(); }
};
/// this type represents an edge (internally it is basically an index)
/// \sa Vertex, Halfedge, Face
struct Edge : public BaseHandle
{
/// default constructor (with invalid index)
explicit Edge(int _idx = -1) : BaseHandle(_idx) {}
};
public: //-------------------------------------------------- connectivity types
/// This type stores the vertex connectivity
/// \sa HalfedgeConnectivity, FaceConnectivity
struct VertexConnectivity
{
/// all edges connected with the vertex
std::vector<Edge> edges_;
};
/// This type stores the edge connectivity
/// \sa VertexConnectivity
struct EdgeConnectivity
{
Vertex source_; /// vertex the edge points to
Vertex target_; /// vertex the edge originates from
};
public: //------------------------------------------------------ property types
/// Vertex property of type T
/// \sa HalfedgeProperty, EdgeProperty, FaceProperty
template <class T> class VertexProperty : public Property<T>
{
public:
/// default constructor
explicit VertexProperty() {}
explicit VertexProperty(Property<T> p) : Property<T>(p) {}
/// access the data stored for vertex \c v
typename Property<T>::reference operator[](Vertex v)
{
return Property<T>::operator[](v.idx());
}
/// access the data stored for vertex \c v
typename Property<T>::const_reference operator[](Vertex v) const
{
return Property<T>::operator[](v.idx());
}
};
/// Edge property of type T
/// \sa VertexProperty, HalfedgeProperty, FaceProperty
template <class T> class EdgeProperty : public Property<T>
{
public:
/// default constructor
explicit EdgeProperty() {}
explicit EdgeProperty(Property<T> p) : Property<T>(p) {}
/// access the data stored for edge \c e
typename Property<T>::reference operator[](Edge e)
{
return Property<T>::operator[](e.idx());
}
/// access the data stored for edge \c e
typename Property<T>::const_reference operator[](Edge e) const
{
return Property<T>::operator[](e.idx());
}
};
/// Graph property of type T
/// \sa VertexProperty, EdgeProperty
template <class T> class ModelProperty : public Property<T>
{
public:
/// default constructor
explicit ModelProperty() {}
explicit ModelProperty(Property<T> p) : Property<T>(p) {}
/// access the data stored for the mesh
typename Property<T>::reference operator[](size_t idx)
{
return Property<T>::operator[](idx);
}
/// access the data stored for the mesh
typename Property<T>::const_reference operator[](size_t idx) const
{
return Property<T>::operator[](idx);
}
};
public: //------------------------------------------------------ iterator types
/// this class iterates linearly over all vertices
/// \sa vertices_begin(), vertices_end()
/// \sa EdgeIterator
class VertexIterator
{
public:
/// Default constructor
VertexIterator(Vertex v = Vertex(), const Graph* g = nullptr) : hnd_(v), graph_(g)
{
if (graph_ && graph_->garbage()) while (graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) ++hnd_.idx_;
}
/// get the vertex the iterator refers to
Vertex operator*() const { return hnd_; }
/// are two iterators equal?
bool operator==(const VertexIterator& rhs) const
{
return (hnd_ == rhs.hnd_);
}
/// are two iterators different?
bool operator!=(const VertexIterator& rhs) const
{
return !operator==(rhs);
}
/// pre-increment iterator
VertexIterator& operator++()
{
++hnd_.idx_;
assert(graph_);
while (graph_->garbage() && graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) ++hnd_.idx_;
return *this;
}
/// pre-decrement iterator
VertexIterator& operator--()
{
--hnd_.idx_;
assert(graph_);
while (graph_->garbage() && graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) --hnd_.idx_;
return *this;
}
private:
Vertex hnd_;
const Graph* graph_;
};
/// this class iterates linearly over all edges
/// \sa edges_begin(), edges_end()
/// \sa VertexIterator
class EdgeIterator
{
public:
/// Default constructor
EdgeIterator(Edge e = Edge(), const Graph* g = nullptr) : hnd_(e), graph_(g)
{
if (graph_ && graph_->garbage()) while (graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) ++hnd_.idx_;
}
/// get the edge the iterator refers to
Edge operator*() const { return hnd_; }
/// are two iterators equal?
bool operator==(const EdgeIterator& rhs) const
{
return (hnd_ == rhs.hnd_);
}
/// are two iterators different?
bool operator!=(const EdgeIterator& rhs) const
{
return !operator==(rhs);
}
/// pre-increment iterator
EdgeIterator& operator++()
{
++hnd_.idx_;
assert(graph_);
while (graph_->garbage() && graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) ++hnd_.idx_;
return *this;
}
/// pre-decrement iterator
EdgeIterator& operator--()
{
--hnd_.idx_;
assert(graph_);
while (graph_->garbage() && graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) --hnd_.idx_;
return *this;
}
private:
Edge hnd_;
const Graph* graph_;
};
public: //-------------------------- containers for C++11 range-based for loops
/// this helper class is a container for iterating through all
/// vertices using C++11 range-based for-loops.
/// \sa vertices()
class VertexContainer
{
public:
VertexContainer(VertexIterator _begin, VertexIterator _end) : begin_(_begin), end_(_end) {}
VertexIterator begin() const { return begin_; }
VertexIterator end() const { return end_; }
private:
VertexIterator begin_, end_;
};
/// this helper class is a container for iterating through all
/// edges using C++11 range-based for-loops.
/// \sa edges()
class EdgeContainer
{
public:
EdgeContainer(EdgeIterator _begin, EdgeIterator _end) : begin_(_begin), end_(_end) {}
EdgeIterator begin() const { return begin_; }
EdgeIterator end() const { return end_; }
private:
EdgeIterator begin_, end_;
};
public: //---------------------------------------------------- circulator types
/// this class circulates through all edges connected with a vertex.
/// it also acts as a container-concept for C++11 range-based for loops.
/// \sa VertexAroundVertexCirculator, edges(Vertex)
class EdgeAroundVertexCirculator
{
public:
/// default constructor
EdgeAroundVertexCirculator(const Graph* g, Vertex v=Vertex())
: graph_(g), vertex_(v), finished_(false)
{
iterator_ = graph_->vconn_[vertex_].edges_.begin();
end_ = graph_->vconn_[vertex_].edges_.end();
}
/// are two circulators equal?
bool operator==(const EdgeAroundVertexCirculator& rhs) const {
assert(graph_);
return ((graph_ == rhs.graph_) && (vertex_ == rhs.vertex_) && (iterator_ == rhs.iterator_))
|| (finished_); // to behave like a circulator
}
/// are two circulators different?
bool operator!=(const EdgeAroundVertexCirculator& rhs) const {
return !operator==(rhs);
}
/// pre-increment
EdgeAroundVertexCirculator& operator++() {
assert(graph_);
++iterator_;
if (iterator_ == end_) { // to behave like a circulator
iterator_ = graph_->vconn_[vertex_].edges_.begin();
finished_ = true;
}
return *this;
}
/// pre-decrement
EdgeAroundVertexCirculator& operator--()
{
assert(graph_);
--iterator_;
return *this;
}
/// get the edge the circulator refers to
Edge operator*() const {
assert(graph_);
if (iterator_ != end_) return *iterator_;
else return Edge();
}
/// cast to bool: true if vertex is not isolated
operator bool() const { return graph_->vconn_[vertex_].edges_.size() > 0; }
/// return current vertex
Vertex vertex() const { return vertex_; }
// helper for C++11 range-based for-loops
EdgeAroundVertexCirculator& begin() { iterator_ = graph_->vconn_[vertex_].edges_.begin(); return *this; }
// helper for C++11 range-based for-loops
EdgeAroundVertexCirculator& end() { iterator_ = end_; return *this; }
private:
const Graph* graph_;
const Vertex vertex_;
std::vector<Edge>::const_iterator iterator_;
// helper for C++11 range-based for-loops
std::vector<Edge>::const_iterator end_;
bool finished_; // for the circulator behavior
};
/// this class circulates through all one-ring neighbors of a vertex.
/// it also acts as a container-concept for C++11 range-based for loops.
/// \sa EdgeAroundVertexCirculator, vertices(Vertex)
class VertexAroundVertexCirculator
{
public:
/// default constructor
VertexAroundVertexCirculator(const Graph* g, Vertex v = Vertex())
: graph_(g), vertex_(v), finished_(false)
{
iterator_ = graph_->vconn_[vertex_].edges_.begin();
end_ = graph_->vconn_[vertex_].edges_.end();
}
/// are two circulators equal?
bool operator==(const VertexAroundVertexCirculator& rhs) const {
assert(graph_);
return ((graph_ == rhs.graph_) && (vertex_ == rhs.vertex_) && (iterator_ == rhs.iterator_))
|| (finished_); // to behave like a circulator
}
/// are two circulators different?
bool operator!=(const VertexAroundVertexCirculator& rhs) const {
return !operator==(rhs);
}
/// pre-increment
VertexAroundVertexCirculator& operator++() {
assert(graph_);
++iterator_;
if (iterator_ == end_) { // to behave like a circulator
iterator_ = graph_->vconn_[vertex_].edges_.begin();
finished_ = true;
}
return *this;
}
/// pre-decrement
VertexAroundVertexCirculator& operator--()
{
assert(graph_);
--iterator_;
return *this;
}
/// get the vertex the circulator refers to
Vertex operator*() const {
assert(graph_);
if (iterator_ != end_) {
Vertex v = graph_->to_vertex(*iterator_);
if (v != vertex_) return v;
else return graph_->from_vertex(*iterator_);
}
return Vertex();
}
/// cast to bool: true if vertex is not isolated
operator bool() const { return graph_->vconn_[vertex_].edges_.size() > 0; }
/// return current vertex
Vertex vertex() const { return vertex_; }
// helper for C++11 range-based for-loops
VertexAroundVertexCirculator& begin() {
iterator_ = graph_->vconn_[vertex_].edges_.begin();
return *this;
}
// helper for C++11 range-based for-loops
VertexAroundVertexCirculator& end() {
iterator_ = end_;
return *this;
}
private:
const Graph* graph_;
const Vertex vertex_;
std::vector<Edge>::const_iterator iterator_;
// helper for C++11 range-based for-loops
std::vector<Edge>::const_iterator end_;
bool finished_; // for the circulator behavior
};
public: //-------------------------------------------- constructor / destructor
/// \name Construct, destruct, assignment
//@{
/// default constructor
Graph();
// destructor (is virtual, since we inherit from Geometry_representation)
virtual ~Graph();
/// copy constructor: copies \c rhs to \c *this. performs a deep copy of all properties.
Graph(const Graph& rhs) { operator=(rhs); }
/// assign \c rhs to \c *this. performs a deep copy of all properties.
Graph& operator=(const Graph& rhs);
/// assign \c rhs to \c *this. does not copy custom properties.
Graph& assign(const Graph& rhs);
//@}
public: //----------------------------------------------- add new vertex / face
/// \name Add new elements by hand
//@{
/// add a new vertex with position \c p
Vertex add_vertex(const vec3& p);
/// add a new edge connecting vertices \c v1 and \c v2
Edge add_edge(const Vertex& v1, const Vertex& v2);
//@}
public: //--------------------------------------------------- memory management
/// \name Memory Management
//@{
/// returns number of (deleted and valid) vertices in the mesh
unsigned int vertices_size() const { return (unsigned int)vprops_.size(); }
/// returns number of (deleted and valid)edges in the mesh
unsigned int edges_size() const { return (unsigned int)eprops_.size(); }
/// returns number of vertices in the mesh
unsigned int n_vertices() const { return vertices_size() - deleted_vertices_; }
/// returns number of edges in the mesh
unsigned int n_edges() const { return edges_size() - deleted_edges_; }
/// returns true iff the mesh is empty, i.e., has no vertices
unsigned int empty() const { return n_vertices() == 0; }
/// clear mesh: remove all vertices, edges, faces
void clear();
/// remove unused memory from vectors
void free_memory();
/// reserve memory (mainly used in file readers)
void reserve(unsigned int nvertices, unsigned int nedges);
/// resizes space for vertices, halfedges, edges, faces, and their currently
/// associated properties.
/// Note: ne is the number of edges. for halfedges, nh = 2 * ne. */
void resize(unsigned int nv, unsigned int ne) {
vprops_.resize(nv);
eprops_.resize(ne);
}
/// remove deleted vertices/edges/faces
void garbage_collection();
/// returns whether vertex \c v is deleted
/// \sa garbage_collection()
bool is_deleted(Vertex v) const
{
return vdeleted_[v];
}
/// returns whether edge \c e is deleted
/// \sa garbage_collection()
bool is_deleted(Edge e) const
{
return edeleted_[e];
}
/// return whether vertex \c v is valid, i.e. the index is stores it within the array bounds.
bool is_valid(Vertex v) const
{
return (0 <= v.idx()) && (v.idx() < (int)vertices_size());
}
/// return whether edge \c e is valid, i.e. the index is stores it within the array bounds.
bool is_valid(Edge e) const
{
return (0 <= e.idx()) && (e.idx() < (int)edges_size());
}
//@}
public: //---------------------------------------------- low-level connectivity
/// \name Low-level connectivity
//@{
/// returns whether \c v is isolated, i.e., not incident to any edge
bool is_isolated(Vertex v) const
{
return vconn_[v].edges_.empty();
}
/// returns the vertex the halfedge \c h points to
Vertex to_vertex(Edge h) const
{
return econn_[h].target_;
}
/// returns the vertex the halfedge \c h emanates from
Vertex from_vertex(Edge h) const
{
return econn_[h].source_;
}
//@}
public: //--------------------------------------------------- property handling
/// \name Property handling
//@{
/** add a vertex property of type \c T with name \c name and default value \c t.
fails if a property named \c name exists already, since the name has to be unique.
in this case it returns an invalid property */
template <class T> VertexProperty<T> add_vertex_property(const std::string& name, const T t = T())
{
return VertexProperty<T>(vprops_.add<T>(name, t));
}
/** add a edge property of type \c T with name \c name and default value \c t.
fails if a property named \c name exists already, since the name has to be unique.
in this case it returns an invalid property */
template <class T> EdgeProperty<T> add_edge_property(const std::string& name, const T t = T())
{
return EdgeProperty<T>(eprops_.add<T>(name, t));
}
/** add a model property of type \c T with name \c name and default value \c t.
fails if a property named \c name exists already, since the name has to be unique.
in this case it returns an invalid property */
template <class T> ModelProperty<T> add_model_property(const std::string& name, const T t = T())
{
return ModelProperty<T>(mprops_.add<T>(name, t));
}
/** get the vertex property named \c name of type \c T. returns an invalid
VertexProperty if the property does not exist or if the type does not match. */
template <class T> VertexProperty<T> get_vertex_property(const std::string& name) const
{
return VertexProperty<T>(vprops_.get<T>(name));
}
/** get the edge property named \c name of type \c T. returns an invalid
VertexProperty if the property does not exist or if the type does not match. */
template <class T> EdgeProperty<T> get_edge_property(const std::string& name) const
{
return EdgeProperty<T>(eprops_.get<T>(name));
}
/** get the model property named \c name of type \c T. returns an invalid
ModelProperty if the property does not exist or if the type does not match. */
template <class T> ModelProperty<T> get_model_property(const std::string& name) const
{
return ModelProperty<T>(mprops_.get<T>(name));
}
/** if a vertex property of type \c T with name \c name exists, it is returned.
otherwise this property is added (with default value \c t) */
template <class T> VertexProperty<T> vertex_property(const std::string& name, const T t = T())
{
return VertexProperty<T>(vprops_.get_or_add<T>(name, t));
}
/** if an edge property of type \c T with name \c name exists, it is returned.
otherwise this property is added (with default value \c t) */
template <class T> EdgeProperty<T> edge_property(const std::string& name, const T t = T())
{
return EdgeProperty<T>(eprops_.get_or_add<T>(name, t));
}
/** if a model property of type \c T with name \c name exists, it is returned.
otherwise this property is added (with default value \c t) */
template <class T> ModelProperty<T> model_property(const std::string& name, const T t = T())
{
return ModelProperty<T>(mprops_.get_or_add<T>(name, t));
}
/// remove the vertex property \c p
template <class T> void remove_vertex_property(VertexProperty<T>& p)
{
vprops_.remove(p);
}
/// remove the edge property \c p
template <class T> void remove_edge_property(EdgeProperty<T>& p)
{
eprops_.remove(p);
}
/// remove the model property \c p
template <class T> void remove_model_property(ModelProperty<T>& p)
{
mprops_.remove(p);
}
/** get the type_info \c T of vertex property named \c. returns an typeid(void)
if the property does not exist or if the type does not match. */
const std::type_info& get_vertex_property_type(const std::string& name)
{
return vprops_.get_type(name);
}
/** get the type_info \c T of edge property named \c. returns an typeid(void)
if the property does not exist or if the type does not match. */
const std::type_info& get_edge_property_type(const std::string& name)
{
return eprops_.get_type(name);
}
/** get the type_info \c T of model property named \c. returns an typeid(void)
if the property does not exist or if the type does not match. */
const std::type_info& get_model_property_type(const std::string& name) const
{
return mprops_.get_type(name);
}
/// returns the names of all vertex properties
std::vector<std::string> vertex_properties() const
{
return vprops_.properties();
}
/// returns the names of all edge properties
std::vector<std::string> edge_properties() const
{
return eprops_.properties();
}
/// returns the names of all model properties
std::vector<std::string> model_properties() const
{
return mprops_.properties();
}
/// prints the names of all properties
void property_stats() const;
//@}
public: //--------------------------------------------- iterators & circulators
/// \name Iterators & Circulators
//@{
/// returns start iterator for vertices
VertexIterator vertices_begin() const
{
return VertexIterator(Vertex(0), this);
}
/// returns end iterator for vertices
VertexIterator vertices_end() const
{
return VertexIterator(Vertex(vertices_size()), this);
}
/// returns vertex container for C++11 range-based for-loops
VertexContainer vertices() const
{
return VertexContainer(vertices_begin(), vertices_end());
}
/// returns start iterator for edges
EdgeIterator edges_begin() const
{
return EdgeIterator(Edge(0), this);
}
/// returns end iterator for edges
EdgeIterator edges_end() const
{
return EdgeIterator(Edge(edges_size()), this);
}
/// returns edge container for C++11 range-based for-loops
EdgeContainer edges() const
{
return EdgeContainer(edges_begin(), edges_end());
}
/// returns circulator for vertices around vertex \c v
VertexAroundVertexCirculator vertices(Vertex v) const
{
return VertexAroundVertexCirculator(this, v);
}
/// returns circulator for edges around vertex \c v
EdgeAroundVertexCirculator edges(Vertex v) const
{
return EdgeAroundVertexCirculator(this, v);
}
//@}
public: //--------------------------------------------- higher-level operations
/// \name Higher-level Topological Operations
//@{
/** returns the valence (number of incident edges or neighboring vertices)
of vertex \c v. */
unsigned int valence(Vertex v) const;
/// find the edge (a,b)
Edge find_edge(Vertex a, Vertex b) const;
/// deletes the vertex \c v from the mesh
void delete_vertex(Vertex v);
/// deletes the edge \c e from the mesh
void delete_edge(Edge e);
//@}
public: //------------------------------------------ geometry-related functions
/// \name Geometry-related Functions
//@{
/// position of a vertex (read only)
const vec3& position(Vertex v) const { return vpoint_[v]; }
/// position of a vertex
vec3& position(Vertex v) { return vpoint_[v]; }
/// vector of vertex positions (read only)
const std::vector<vec3>& points() const { return vpoint_.vector(); }
/// vector of vertex positions
std::vector<vec3>& points() { return vpoint_.vector(); }
/// compute the length of edge \c e.
float edge_length(Edge e) const;
//@}
private: //---------------------------------------------- allocate new elements
/// allocate a new vertex, resize vertex properties accordingly.
Vertex new_vertex()
{
vprops_.push_back();
return Vertex(vertices_size() - 1);
}
/// allocate a new edge, resize edge roperties accordingly.
Edge new_edge()
{
eprops_.push_back();
return Edge(edges_size() - 1);
}
private: //--------------------------------------------------- helper functions
/// are there deleted vertices, edges or faces?
bool garbage() const { return garbage_; }
private: //------------------------------------------------------- private data
PropertyContainer vprops_;
PropertyContainer eprops_;
PropertyContainer mprops_;
VertexProperty<VertexConnectivity> vconn_;
EdgeProperty<EdgeConnectivity> econn_;
VertexProperty<bool> vdeleted_;
EdgeProperty<bool> edeleted_;
VertexProperty<vec3> vpoint_;
unsigned int deleted_vertices_;
unsigned int deleted_edges_;
bool garbage_;
};
//------------------------------------------------------------ output operators
inline std::ostream& operator<<(std::ostream& os, Graph::Vertex v)
{
return (os << 'v' << v.idx());
}
inline std::ostream& operator<<(std::ostream& os, Graph::Edge e)
{
return (os << 'e' << e.idx());
}
} // namespace easy3d
#endif // EASY3D_SURFACE_MESH_H

View File

@ -1,104 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_LINE_H
#define EASY3D_LINE_H
#include <easy3d/core/vec.h>
namespace easy3d {
template <int DIM, typename FT>
class GenericLine {
public:
typedef Vec<DIM, FT> Point;
typedef Vec<DIM, FT> Vector;
typedef GenericLine<DIM, FT> thisclass;
public:
static GenericLine from_point_and_direction(const Point& p, const Vector& dir) { return GenericLine(p, dir); }
static GenericLine from_two_points(const Point& p, const Point& q) { return GenericLine(p, q - p); }
GenericLine() {}
void set(const Point& p, const Vector& dir) {
p_ = p;
dir_ = normalize(dir);
}
const Vector& direction() const { return dir_; }
const Point& point() const { return p_; }
GenericLine opposite() const { return GenericLine(p_, -dir_); }
// the projection of p on this line
Point projection(const Point &p) const { return p_ + dir_ * dot(p - p_, dir_); }
FT squared_ditance(const Point &p) const { return length2(projection(p) - p); }
private: // Ambiguities exist for this one.
GenericLine(const Point & p, const Vector & dir);
private:
Point p_;
Vector dir_;
};
template <int DIM, typename FT> inline
GenericLine<DIM, FT>::GenericLine(const Point & p, const Vector & dir) : p_(p) {
dir_ = normalize(dir);
#ifndef NDEBUG // degenerate case
if (length(dir_) < 1e-15) {
std::cerr << "degenerate line constructed from point ("
<< p << ") and direction (" << dir << ")" << std::endl;
}
#endif
}
template <int DIM, typename FT> inline
std::ostream& operator<<(std::ostream& os, const GenericLine<DIM, FT>& line) {
return os << line.point() << " " << line.direction();
}
template <int DIM, typename FT> inline
std::istream& operator>>(std::istream& is, GenericLine<DIM, FT>& line) {
typename GenericLine<DIM, FT>::Point p;
typename GenericLine<DIM, FT>::Vector dir;
is >> p >> dir;
line.set(p, dir);
return is;
}
}
#endif // EASY3D_LINE_H

File diff suppressed because it is too large Load Diff

View File

@ -1,360 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_PLANE_H
#define EASY3D_PLANE_H
#include <easy3d/core/vec.h>
#include <easy3d/core/line.h>
namespace easy3d {
// A 3D Plane of equation a.x + b.y + c.z + d = 0
template <typename FT>
class GenericPlane
{
public:
typedef Vec<2, FT> Point2;
typedef Vec<3, FT> Point3;
typedef Vec<3, FT> Vector3;
typedef GenericLine<3, FT> Line3;
typedef GenericPlane<FT> thisclass;
public:
GenericPlane(const Point3& p1, const Point3& p2, const Point3& p3);
GenericPlane(const Point3& p, const Vector3& n);
GenericPlane(FT a, FT b, FT c, FT d) { coeff_[0] = a; coeff_[1] = b; coeff_[2] = c; coeff_[3] = d; }
GenericPlane() {}
inline FT a() const { return coeff_[0]; }
inline FT b() const { return coeff_[1]; }
inline FT c() const { return coeff_[2]; }
inline FT d() const { return coeff_[3]; }
inline FT& operator[](size_t idx) { assert(idx < 4); return coeff_[idx]; }
inline const FT& operator[](size_t idx) const { assert(idx < 4); return coeff_[idx]; }
// returns the normal of the plane
Vector3 normal() const;
// return a point lying on this plane.
// NOTE: it is a fixed point (anytime you can this function it returns
// the same point).
Point3 point() const;
// return two orthogonal directions on this plane
Vector3 base1() const;
Vector3 base2() const;
// 2D / 3D conversion: relative to the coordinate system defined
// by the three orthogonal vectors: (base1, base2, normal).
// NOTE: after 3D->2D and then 2D->3D conversion, the resulted 3D
// point will remain unchanged ONLY IF the input point lies
// on the plane. In case the original 3D point does not lie
// on the plane, the resulted 3D point will have coordinates
// equal to the projection of the input point onto the plane.
Point2 to_2d(const Point3& p) const;
Point3 to_3d(const Point2& p) const;
// the projection of a point 'p' on this plane
Point3 projection(const Point3 &p) const;
// given a point 'p', compute the value of the equation
inline FT value(const Point3& p) const { return (coeff_[0] * p.x + coeff_[1] * p.y + coeff_[2] * p.z + coeff_[3]); }
// squared distance of a point 'p' to this plane
FT squared_ditance(const Point3 &p) const;
// compute the intersection with 'line'.
// returns false if the line is parallel with this plane.
// NOTE: both line and the plane are unlimited.
bool intersect(const Line3& line, Point3& p) const;
// test if this plane intersects with a line.
bool intersect(const Line3& line) const;
// compute the intersection with a line segment (s, t).
// returns false if there is no intersection (i.e., s and t lie in the same side).
bool intersect(const Point3& s, const Point3& t, Point3& p) const;
// test if this plane intersects with a line segment (s, t).
bool intersect(const Point3& s, const Point3& t) const;
// return values:
// 1: p is on the positive side
// 0: p is belonging to the plane
// -1: p is on the negative side
int orient(const Point3& p) const;
// returns the memory address of the coefficients.
const FT* data() const { return coeff_; }
FT* data() { return coeff_; }
// Conversion operator returning the memory address of the coefficients.
// Very convenient to pass the data pointer as a parameter to functions.
operator const FT*() const { return coeff_; }
operator FT*() { return coeff_; }
private:
FT coeff_[4]; // representing the a, b, c, and d, respectively
};
template <typename FT> std::ostream& operator<<(std::ostream& os, const GenericPlane<FT>& plane);
template <typename FT> std::istream& operator>>(std::istream& is, GenericPlane<FT>& plane);
template <typename FT> inline
GenericPlane<FT>::GenericPlane(const Point3& p1, const Point3& p2, const Point3& p3) {
Vector3 n = cross(p2 - p1, p3 - p1);
n = normalize(n);
coeff_[0] = n.x;
coeff_[1] = n.y;
coeff_[2] = n.z;
coeff_[3] = -(coeff_[0] * p1.x + coeff_[1] * p1.y + coeff_[2] * p1.z);
#ifndef NDEBUG // degenerate case
if (length(n) < 1e-15) {
std::cerr << "degenerate plane constructed from 3 points:" << std::endl
<< "\t(" << p1 << ")" << std::endl
<< "\t(" << p2 << ")" << std::endl
<< "\t(" << p3 << ")" << std::endl;
}
#endif
}
template <typename FT> inline
GenericPlane<FT>::GenericPlane(const Point3& p, const Vector3& n) {
Vector3 nn = normalize(n);
coeff_[0] = nn.x;
coeff_[1] = nn.y;
coeff_[2] = nn.z;
coeff_[3] = -(coeff_[0] * p.x + coeff_[1] * p.y + coeff_[2] * p.z);
#ifndef NDEBUG // degenerate case
if (length(nn) < 1e-15) {
std::cerr << "degenerate plane constructed from point ("
<< p << ") and normal (" << n << ")" << std::endl;
}
#endif
}
template <typename FT> inline
typename GenericPlane<FT>::Vector3 GenericPlane<FT>::normal() const {
Vector3 n = normalize(Vector3(coeff_[0], coeff_[1], coeff_[2]));
#ifndef NDEBUG // degenerate case
if (length(n) < 1e-15) {
std::cerr << "degenerate plane with normal: (" << n << ")" << std::endl;
}
#endif
return n;
}
template <typename FT> inline
typename GenericPlane<FT>::Vector3 GenericPlane<FT>::base1() const {
if (coeff_[0] == 0) // parallel to x-axis
return Vector3(FT(1), FT(0), FT(0));
else if (coeff_[1] == 0) // parallel to y-axis
return Vector3(FT(0), FT(1), FT(0));
else if (coeff_[2] == 0) // parallel to z-axis
return Vector3(FT(0), FT(0), FT(1));
else {
Vector3 base(-coeff_[1], coeff_[0], FT(0));
return normalize(base);
}
}
template <typename FT> inline
typename GenericPlane<FT>::Vector3 GenericPlane<FT>::base2() const {
Vector3 base = cross(normal(), base1());
return normalize(base);
}
template <typename FT> inline
typename GenericPlane<FT>::Point2 GenericPlane<FT>::to_2d(const Point3& p) const {
Vector3 vec = p - point();
FT x = dot(vec, base1());
FT y = dot(vec, base2());
return Point2(x, y);
}
template <typename FT> inline
typename GenericPlane<FT>::Point3 GenericPlane<FT>::to_3d(const Point2& p) const {
return point() + base1() * p.x + base2() * p.y;
}
template <typename FT> inline
typename GenericPlane<FT>::Point3 GenericPlane<FT>::point() const {
Point3 p(FT(0), FT(0), FT(0));
if (coeff_[0] >= coeff_[1] && coeff_[0] >= coeff_[2])
p.x = -coeff_[3] / coeff_[0];
else if (coeff_[1] >= coeff_[0] && coeff_[1] >= coeff_[2])
p.y = -coeff_[3] / coeff_[1];
else
p.z = -coeff_[3] / coeff_[2];
return p;
// the code below is not numerically stable
//Point3 p(FT(0), FT(0), FT(0));
//if (coeff_[0] != 0)
// p.x = -coeff_[3] / coeff_[0];
//else if (coeff_[1] != 0)
// p.y = -coeff_[3] / coeff_[1];
//else
// p.z = -coeff_[3] / coeff_[2];
//return p;
}
// return values:
// 1: p is on the positive side
// -1: p is on the negative side
// 0: the point p is and 0 if the point is belonging the plane.
template <typename FT> inline
int GenericPlane<FT>::orient(const Point3& p) const {
FT v = value(p);
if (std::abs(v) < 1e-15)
return 0;
return (v > 0.0 ? 1 : -1);
}
template <typename FT> inline
typename GenericPlane<FT>::Point3 GenericPlane<FT>::projection(const Point3& p) const {
// the equation of the plane is Ax+By+Cz+D=0
// the normal direction is (A,B,C)
// the projected point is p-lambda(A,B,C) where
// A(x-lambda*A) + B(y-lambda*B) + C(z-lambda*C) + D = 0
FT num = coeff_[0] * p.x + coeff_[1] * p.y + coeff_[2] * p.z + coeff_[3];
FT den = coeff_[0] * coeff_[0] + coeff_[1] * coeff_[1] + coeff_[2] * coeff_[2];
FT lambda = num / den;
FT x = p.x - lambda * coeff_[0];
FT y = p.y - lambda * coeff_[1];
FT z = p.z - lambda * coeff_[2];
return Point3(x, y, z);
}
template <typename FT> inline
FT GenericPlane<FT>::squared_ditance(const Point3& p) const {
FT v = value(p);
return (v * v) / (coeff_[0] * coeff_[0] + coeff_[1] * coeff_[1] + coeff_[2] * coeff_[2]);
}
template <typename FT> inline
bool GenericPlane<FT>::intersect(const Line3& line) const {
Vector3 dir = line.direction();
FT c = dot(dir, normal());
if (std::abs(c) < 1e-15)
return false;
else
return true;
}
template <typename FT> inline
bool GenericPlane<FT>::intersect(const Line3& line, Point3& p) const {
const Vector3& dir = line.direction();
FT c = dot(dir, normal());
if (std::abs(c) < 1e-15)
return false;
const Point3& p0 = line.point();
// p = p0 + dir * t
// equation: p is in the plane (so we first compute t)
FT t = -(coeff_[0] * p0.x + coeff_[1] * p0.y + coeff_[2] * p0.z + coeff_[3]) / (coeff_[0] * dir.x + coeff_[1] * dir.y + coeff_[2] * dir.z);
p = p0 + dir * t;
return true;
}
template <typename FT> inline
bool GenericPlane<FT>::intersect(const Point3& s, const Point3& t) const {
int ss = orient(s);
int st = orient(t);
if ((ss == 1 && st == -1) || (ss == -1 && st == 1))
return true;
else if (ss == 0 || st == 0)
return true;
else
return false;
}
template <typename FT> inline
bool GenericPlane<FT>::intersect(const Point3& s, const Point3& t, Point3& p) const {
int ss = orient(s);
int st = orient(t);
if ((ss == 1 && st == -1) || (ss == -1 && st == 1)) {
if (intersection(Line3::from_two_points(s, t), p))
return true;
else {
std::cerr << "fatal error. Should have intersection" << std::endl;
return false;
}
}
else {
if (ss == 0) {
p = s;
return true;
}
else if (st == 0) {
p = t;
return true;
}
else {
// no intersection with the plane
return false;
}
}
}
template <typename FT> inline
std::ostream& operator<<(std::ostream& os, const GenericPlane<FT>& plane) {
return os << plane[0] << ' ' << plane[1] << ' ' << plane[2] << ' ' << plane[3];
}
template <typename FT> inline
std::istream& operator>>(std::istream& is, GenericPlane<FT>& plane) {
return is >> plane[0] >> plane[1] >> plane[2] >> plane[3];
}
}
#endif // EASY3D_PLANE_H

View File

@ -1,250 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
/** ----------------------------------------------------------
*
* the code is adapted from Surface_mesh with modifications.
* - Surface_mesh (version 1.1)
* The original code is available at
* https://opensource.cit-ec.de/projects/surface_mesh
*
* Surface_mesh is a halfedge-based mesh data structure for
* representing and processing 2-manifold polygonal surface
* meshes. It is implemented in C++ and designed with an
* emphasis on simplicity and efficiency.
*
*----------------------------------------------------------*/
//== INCLUDES =================================================================
#include <easy3d/core/point_cloud.h>
#include <cmath>
//== NAMESPACE ================================================================
namespace easy3d {
//== IMPLEMENTATION ===========================================================
PointCloud::PointCloud()
{
// allocate standard properties
// same list is used in operator=() and assign()
vpoint_ = add_vertex_property<vec3>("v:point");
vdeleted_ = add_vertex_property<bool>("v:deleted", false);
mprops_.push_back();
deleted_vertices_ = 0;
garbage_ = false;
}
//-----------------------------------------------------------------------------
PointCloud::~PointCloud()
{
}
//-----------------------------------------------------------------------------
PointCloud& PointCloud::operator=(const PointCloud& rhs)
{
if (this != &rhs)
{
// deep copy of property containers
vprops_ = rhs.vprops_;
mprops_ = rhs.mprops_;
// property handles contain pointers, have to be reassigned
vdeleted_ = vertex_property<bool>("v:deleted");
vpoint_ = vertex_property<vec3>("v:point");
// how many elements are deleted?
deleted_vertices_ = rhs.deleted_vertices_;
garbage_ = rhs.garbage_;
}
return *this;
}
//-----------------------------------------------------------------------------
PointCloud& PointCloud::assign(const PointCloud& rhs)
{
if (this != &rhs)
{
// clear properties
vprops_.clear();
mprops_.clear();
// allocate standard properties
vpoint_ = add_vertex_property<vec3>("v:point");
vdeleted_ = add_vertex_property<bool>("v:deleted", false);
// copy properties from other cloud
vpoint_.array() = rhs.vpoint_.array();
vdeleted_.array() = rhs.vdeleted_.array();
// resize (needed by property containers)
vprops_.resize(rhs.vertices_size());
mprops_.resize(1);
// how many elements are deleted?
deleted_vertices_ = rhs.deleted_vertices_;
garbage_ = rhs.garbage_;
}
return *this;
}
//-----------------------------------------------------------------------------
void PointCloud::clear()
{
vprops_.resize(0);
free_memory();
deleted_vertices_ = 0;
garbage_ = false;
}
//-----------------------------------------------------------------------------
void PointCloud::free_memory()
{
vprops_.free_memory();
}
//-----------------------------------------------------------------------------
void PointCloud::property_stats() const
{
std::vector<std::string> props = vertex_properties();
std::cout << "vertex properties:\n";
for (unsigned int i=0; i<props.size(); ++i)
std::cout << "\t" << props[i] << std::endl;
std::cout << "model properties:\n";
props = model_properties();
for (unsigned int i = 0; i < props.size(); ++i)
std::cout << "\t" << props[i] << std::endl;
}
//-----------------------------------------------------------------------------
PointCloud::Vertex PointCloud::add_vertex(const vec3& p)
{
Vertex v = new_vertex();
vpoint_[v] = p;
return v;
}
//-----------------------------------------------------------------------------
void PointCloud::delete_vertex(Vertex v)
{
if (vdeleted_[v]) return;
// mark v as deleted
vdeleted_[v] = true;
deleted_vertices_++;
garbage_ = true;
}
//-----------------------------------------------------------------------------
void PointCloud::garbage_collection()
{
int nV(vertices_size());
// setup handle mapping
VertexProperty<Vertex> vmap = add_vertex_property<Vertex>("v:garbage-collection");
for (int i=0; i<nV; ++i)
vmap[Vertex(i)] = Vertex(i);
// remove deleted vertices
if (nV > 0)
{
int i0 = 0;
int i1 = nV - 1;
while (1)
{
// find first deleted and last un-deleted
while (!vdeleted_[Vertex(i0)] && i0 < i1) ++i0;
while ( vdeleted_[Vertex(i1)] && i0 < i1) --i1;
if (i0 >= i1) break;
// swap
vprops_.swap(i0, i1);
};
// remember new size
nV = vdeleted_[Vertex(i0)] ? i0 : i0+1;
}
// remove handle maps
remove_vertex_property(vmap);
// finally resize arrays
vprops_.resize(nV);
vprops_.free_memory();
deleted_vertices_ = 0;
garbage_ = false;
}
//=============================================================================
} // namespace point_cloud
//=============================================================================

View File

@ -1,500 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
/** ----------------------------------------------------------
*
* the code is adapted from Surface_mesh with modifications.
* - Surface_mesh (version 1.1)
* The original code is available at
* https://opensource.cit-ec.de/projects/surface_mesh
*
* Surface_mesh is a halfedge-based mesh data structure for
* representing and processing 2-manifold polygonal surface
* meshes. It is implemented in C++ and designed with an
* emphasis on simplicity and efficiency.
*
*----------------------------------------------------------*/
// I would like to process/visualize huge scans (tens of millions of points, or even more),
// an earlier implementation based on double-connected list has the following issues:
// 1) no random access of the data;
// 2) OpenGL renderring overhead (needs packing to transfer data to GPU);
// 3) hard to employ OMP support;
// 4) file management (unable to read and write large blocks);
// 5) selection, etc.
// Thus I have this implementation inspired by (actually some code is taken from)
// Surface_mesh: https://opensource.cit-ec.de/projects/surface_mesh
// The idea behind is that point coordinates and associated attribute values are stored as
// std::vector<T>.
#ifndef EASY3D_POINT_CLOUD_H
#define EASY3D_POINT_CLOUD_H
//== INCLUDES =================================================================
#include <easy3d/viewer/model.h>
#include <easy3d/core/types.h>
#include <easy3d/core/properties.h>
//== NAMESPACE ================================================================
namespace easy3d {
//== CLASS DEFINITION =========================================================
/// A for point clouds.
class PointCloud : public Model
{
public: //------------------------------------------------------ topology types
/// Base class for topology types (internally it is basically an index)
/// \sa Vertex
class BaseHandle
{
public:
/// constructor
explicit BaseHandle(int _idx=-1) : idx_(_idx) {}
/// Get the underlying index of this handle
int idx() const { return idx_; }
/// reset handle to be invalid (index=-1)
void reset() { idx_=-1; }
/// return whether the handle is valid, i.e., the index is not equal to -1.
bool is_valid() const { return idx_ != -1; }
/// are two handles equal?
bool operator==(const BaseHandle& _rhs) const {
return idx_ == _rhs.idx_;
}
/// are two handles different?
bool operator!=(const BaseHandle& _rhs) const {
return idx_ != _rhs.idx_;
}
/// compare operator useful for sorting handles
bool operator<(const BaseHandle& _rhs) const {
return idx_ < _rhs.idx_;
}
private:
friend class VertexIterator;
friend class PointCloud;
int idx_;
};
/// this type represents a vertex (internally it is basically an index)
struct Vertex : public BaseHandle
{
/// default constructor (with invalid index)
explicit Vertex(int _idx=-1) : BaseHandle(_idx) {}
std::ostream& operator<<(std::ostream& os) const { return os << 'v' << idx(); }
};
public: //------------------------------------------------------ property types
/// Vertex property of type T
template <class T> class VertexProperty : public Property<T>
{
public:
/// default constructor
explicit VertexProperty() {}
explicit VertexProperty(Property<T> p) : Property<T>(p) {}
/// access the data stored for vertex \c v
typename Property<T>::reference operator[](Vertex v)
{
return Property<T>::operator[](v.idx());
}
/// access the data stored for vertex \c v
typename Property<T>::const_reference operator[](Vertex v) const
{
return Property<T>::operator[](v.idx());
}
};
/// Cloud property of type T
/// \sa VertexProperty
template <class T> class ModelProperty : public Property<T>
{
public:
/// default constructor
explicit ModelProperty() {}
explicit ModelProperty(Property<T> p) : Property<T>(p) {}
/// access the data stored for the cloud
typename Property<T>::reference operator[](size_t idx)
{
return Property<T>::operator[](idx);
}
/// access the data stored for the cloud
typename Property<T>::const_reference operator[](size_t idx) const
{
return Property<T>::operator[](idx);
}
};
public: //------------------------------------------------------ iterator types
/// this class iterates linearly over all vertices
/// \sa vertices_begin(), vertices_end()
class VertexIterator
{
public:
/// Default constructor
VertexIterator(Vertex v=Vertex(), const PointCloud* m=nullptr) : hnd_(v), cloud_(m)
{
if (cloud_ && cloud_->garbage()) while (cloud_->is_valid(hnd_) && cloud_->is_deleted(hnd_)) ++hnd_.idx_;
}
/// get the vertex the iterator refers to
Vertex operator*() const { return hnd_; }
/// are two iterators equal?
bool operator==(const VertexIterator& rhs) const
{
return (hnd_==rhs.hnd_);
}
/// are two iterators different?
bool operator!=(const VertexIterator& rhs) const
{
return !operator==(rhs);
}
/// pre-increment iterator
VertexIterator& operator++()
{
++hnd_.idx_;
assert(cloud_);
while (cloud_->garbage() && cloud_->is_valid(hnd_) && cloud_->is_deleted(hnd_)) ++hnd_.idx_;
return *this;
}
/// pre-decrement iterator
VertexIterator& operator--()
{
--hnd_.idx_;
assert(cloud_);
while (cloud_->garbage() && cloud_->is_valid(hnd_) && cloud_->is_deleted(hnd_)) --hnd_.idx_;
return *this;
}
private:
Vertex hnd_;
const PointCloud* cloud_;
};
public: //-------------------------- containers for C++11 range-based for loops
/// this helper class is a container for iterating through all
/// vertices using C++11 range-based for-loops.
/// \sa vertices()
class VertexContainer
{
public:
VertexContainer(VertexIterator _begin, VertexIterator _end) : begin_(_begin), end_(_end) {}
VertexIterator begin() const { return begin_; }
VertexIterator end() const { return end_; }
private:
VertexIterator begin_, end_;
};
public: //-------------------------------------------- constructor / destructor
/// \name Construct, destruct, assignment
//@{
/// default constructor
PointCloud();
// destructor (is virtual, since we inherit from Geometry_representation)
virtual ~PointCloud();
/// copy constructor: copies \c rhs to \c *this. performs a deep copy of all properties.
PointCloud(const PointCloud& rhs) { operator=(rhs); }
/// assign \c rhs to \c *this. performs a deep copy of all properties.
PointCloud& operator=(const PointCloud& rhs);
/// assign \c rhs to \c *this. does not copy custom properties.
PointCloud& assign(const PointCloud& rhs);
//@}
public: //----------------------------------------------- add new vertex
/// \name Add new elements by hand
//@{
/// add a new vertex with position \c p
Vertex add_vertex(const vec3& p);
//@}
public: //--------------------------------------------------- memory management
/// \name Memory Management
//@{
/// returns number of (deleted and valid) vertices in the cloud
unsigned int vertices_size() const { return (unsigned int) vprops_.size(); }
/// returns number of vertices in the cloud
unsigned int n_vertices() const { return vertices_size() - deleted_vertices_; }
/// returns true iff the cloud is empty, i.e., has no vertices
unsigned int empty() const { return n_vertices() == 0; }
/// clear cloud: remove all vertices
void clear();
/// remove unused memory from vectors
void free_memory();
/// resize space for vertices and their currently associated properties.
void resize(unsigned int nv) { vprops_.resize(nv); }
/// remove deleted vertices
void garbage_collection();
/// deletes the vertex \c v from the cloud
void delete_vertex(Vertex v);
/// returns whether vertex \c v is deleted
/// \sa garbage_collection()
bool is_deleted(Vertex v) const
{
return vdeleted_[v];
}
/// return whether vertex \c v is valid, i.e. the index is stores it within the array bounds.
bool is_valid(Vertex v) const
{
return (0 <= v.idx()) && (v.idx() < (int)vertices_size());
}
//@}
public: //--------------------------------------------------- property handling
/// \name Property handling
//@{
/** add a vertex property of type \c T with name \c name and default value \c t.
fails if a property named \c name exists already, since the name has to be unique.
in this case it returns an invalid property */
template <class T> VertexProperty<T> add_vertex_property(const std::string& name, const T t=T())
{
return VertexProperty<T>(vprops_.add<T>(name, t));
}
/** add a model property of type \c T with name \c name and default value \c t.
fails if a property named \c name exists already, since the name has to be unique.
in this case it returns an invalid property */
template <class T> ModelProperty<T> add_model_property(const std::string& name, const T t = T())
{
return ModelProperty<T>(mprops_.add<T>(name, t));
}
/** get the vertex property named \c name of type \c T. returns an invalid
VertexProperty if the property does not exist or if the type does not match. */
template <class T> VertexProperty<T> get_vertex_property(const std::string& name) const
{
return VertexProperty<T>(vprops_.get<T>(name));
}
/** get the model property named \c name of type \c T. returns an invalid
ModelProperty if the property does not exist or if the type does not match. */
template <class T> ModelProperty<T> get_model_property(const std::string& name) const
{
return ModelProperty<T>(mprops_.get<T>(name));
}
/** if a vertex property of type \c T with name \c name exists, it is returned.
otherwise this property is added (with default value \c t) */
template <class T> VertexProperty<T> vertex_property(const std::string& name, const T t=T())
{
return VertexProperty<T>(vprops_.get_or_add<T>(name, t));
}
/** if a model property of type \c T with name \c name exists, it is returned.
otherwise this property is added (with default value \c t) */
template <class T> ModelProperty<T> model_property(const std::string& name, const T t = T())
{
return ModelProperty<T>(mprops_.get_or_add<T>(name, t));
}
/// remove the vertex property \c p
template <class T> void remove_vertex_property(VertexProperty<T>& p)
{
vprops_.remove(p);
}
/// remove the model property \c p
template <class T> void remove_model_property(ModelProperty<T>& p)
{
mprops_.remove(p);
}
/** get the type_info \c T of vertex property named \c. returns an typeid(void)
if the property does not exist or if the type does not match. */
const std::type_info& get_vertex_property_type(const std::string& name)
{
return vprops_.get_type(name);
}
/** get the type_info \c T of model property named \c. returns an typeid(void)
if the property does not exist or if the type does not match. */
const std::type_info& get_model_property_type(const std::string& name) const
{
return mprops_.get_type(name);
}
/// returns the names of all vertex properties
std::vector<std::string> vertex_properties() const
{
return vprops_.properties();
}
/// returns the names of all model properties
std::vector<std::string> model_properties() const
{
return mprops_.properties();
}
/// prints the names of all properties
void property_stats() const;
//@}
public: //--------------------------------------------- iterators
/// \name Iterators
//@{
/// returns start iterator for vertices
VertexIterator vertices_begin() const
{
return VertexIterator(Vertex(0), this);
}
/// returns end iterator for vertices
VertexIterator vertices_end() const
{
return VertexIterator(Vertex(vertices_size()), this);
}
/// returns vertex container for C++11 range-based for-loops
VertexContainer vertices() const
{
return VertexContainer(vertices_begin(), vertices_end());
}
//@}
public: //------------------------------------------ geometry-related functions
/// \name Geometry-related Functions
//@{
/// position of a vertex (read only)
const vec3& position(Vertex v) const { return vpoint_[v]; }
/// position of a vertex
vec3& position(Vertex v) { return vpoint_[v]; }
/// vector of vertex positions (read only)
const std::vector<vec3>& points() const { return vpoint_.vector(); }
/// vector of vertex positions
std::vector<vec3>& points() { return vpoint_.vector(); }
//@}
private: //---------------------------------------------- allocate new elements
/// allocate a new vertex, resize vertex properties accordingly.
Vertex new_vertex()
{
vprops_.push_back();
return Vertex(vertices_size()-1);
}
private: //--------------------------------------------------- helper functions
/// are there deleted vertices
bool garbage() const { return garbage_; }
private: //------------------------------------------------------- private data
PropertyContainer vprops_;
PropertyContainer mprops_;
VertexProperty<bool> vdeleted_;
VertexProperty<vec3> vpoint_;
unsigned int deleted_vertices_;
bool garbage_;
};
//------------------------------------------------------------ output operators
inline std::ostream& operator<<(std::ostream& os, PointCloud::Vertex v)
{
return (os << 'v' << v.idx());
}
//=============================================================================
} // namespace easy3d
//=============================================================================
#endif // EASY3D_POINT_CLOUD_H
//=============================================================================

View File

@ -1,213 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_PRINCIPAL_AXIS_H
#define EASY3D_PRINCIPAL_AXIS_H
#include <easy3d/core/types.h>
namespace easy3d {
/**
* PrincipalAxes computes the center and inertia axes of
* a set of 2D or 3D points.
* @tparam DIM dimension (must be 2 or 3)
*/
//NOTE: 2D cases has not been tested!!!
template <int DIM, typename FT>
class PrincipalAxes {
public:
PrincipalAxes();
~PrincipalAxes();
// add point one by one
void begin();
void add_point(const Vec<DIM, FT>& p, FT weight = FT(1.0));
void end();
// add a set of point (it internally calls add_point())
template <typename InputIterator>
void add_points(InputIterator first, InputIterator last);
Vec<DIM, FT> center() const;
// eigen values are sorted in descending order,
// eigen vectors are sorted in accordance.
Vec<DIM, FT> axis(int i) const;
FT eigen_value(int i) const ;
private:
FT center_[DIM];
FT axis_[DIM][DIM];
FT eigen_value_[DIM];
FT** M_;
int nb_points_;
FT sum_weights_;
} ;
} // namespace easy3d
#include <cassert>
#include <easy3d/core/eigen_solver.h>
namespace easy3d {
template <int DIM, typename FT>
PrincipalAxes<DIM, FT>::PrincipalAxes() {
M_ = new FT*[DIM];
for (unsigned short i = 0; i < DIM; ++i)
M_[i] = new FT[DIM];
}
template <int DIM, typename FT>
PrincipalAxes<DIM, FT>::~PrincipalAxes() {
for (unsigned short i = 0; i < DIM; ++i)
delete[] M_[i];
delete[] M_;
}
template <int DIM, typename FT>
inline Vec<DIM, FT> PrincipalAxes<DIM, FT>::center() const {
return Vec<DIM, FT>(center_) ;
}
template <int DIM, typename FT>
inline Vec<DIM, FT> PrincipalAxes<DIM, FT>::axis(int i) const {
assert(i >= 0 && i < DIM) ;
return Vec<DIM, FT>(axis_[i]) ;
}
template <int DIM, typename FT>
inline FT PrincipalAxes<DIM, FT>::eigen_value(int i) const {
assert(i >= 0 && i < DIM) ;
return eigen_value_[i] ;
}
template <int DIM, typename FT>
inline void PrincipalAxes<DIM, FT>::begin() {
nb_points_ = 0 ;
sum_weights_ = 0 ;
for (unsigned short i = 0; i < DIM; ++i) {
center_[i] = 0;
for (unsigned short j = 0; j < DIM; ++j)
M_[i][j] = 0;
}
}
template <int DIM, typename FT>
inline void PrincipalAxes<DIM, FT>::end() {
for (unsigned short i = 0; i < DIM; ++i)
center_[i] /= sum_weights_;
// If the system is under-determined, return the trivial basis.
if(nb_points_ < DIM + 1) {
for (unsigned short i = 0; i < DIM; ++i) {
eigen_value_[i] = FT(1.0) ;
for (unsigned short j = 0; j < DIM; ++j)
axis_[i][j] = (i == j ? FT(1) : FT(0));
}
}
else {
for (unsigned short i = 0; i < DIM; ++i) {
for (unsigned short j = i; j < DIM; ++j) {
M_[i][j] = M_[i][j]/sum_weights_ - center_[i]*center_[j];
if (i != j)
M_[j][i] = M_[i][j];
}
if( M_[i][i] <= FT(0) )
M_[i][i] = std::numeric_limits<FT>::min();
}
EigenSolver<FT> solver(DIM);
solver.solve(M_, EigenSolver<FT>::DECREASING);
for (unsigned short i=0; i<DIM; ++i) {
eigen_value_[i] = solver.eigen_value(i);
for (unsigned short j=0; j<DIM; ++j)
axis_[i][j] = solver.eigen_vector(j, i); // eigenvectors are stored in columns
}
// Normalize the eigen vectors
for(unsigned short i=0; i<DIM; i++) {
FT sqr_len(0);
for(unsigned short j=0; j<DIM; j++)
sqr_len += (axis_[i][j] * axis_[i][j]);
FT s = std::sqrt(sqr_len);
s = (s > std::numeric_limits<FT>::min()) ? FT(1.0) / s : FT(0.0);
for (unsigned short j = 0; j < DIM; ++j)
axis_[i][j] *= s;
}
}
}
// The covariance matrix:
// If A and B have components a_i and b_j respectively, then
// the covariance matrix C has a_i*b_j as its ij-th entry.
template <int DIM, typename FT>
inline void PrincipalAxes<DIM, FT>::add_point(const Vec<DIM, FT>& p, FT weight) {
for (unsigned short i = 0; i < DIM; ++i) {
center_[i] += p[i] * weight ;
for (unsigned short j = i; j < DIM; ++j)
M_[i][j] += weight * p[i] * p[j];
}
nb_points_++ ;
sum_weights_ += weight ;
}
// add a set of point (it internally calls add_point())
template <int DIM, typename FT>
template <typename InputIterator >
inline void PrincipalAxes<DIM, FT>::add_points(InputIterator first, InputIterator last) {
assert(first != last);
begin();
for (InputIterator it = first; it != last; ++it) {
add_point(*it);
}
end();
}
} // namespace easy3d
#endif

View File

@ -1,458 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
/** ----------------------------------------------------------
*
* the code is adapted from Surface_mesh with modifications.
* - Surface_mesh (version 1.1)
* The original code is available at
* https://opensource.cit-ec.de/projects/surface_mesh
*
* Surface_mesh is a halfedge-based mesh data structure for
* representing and processing 2-manifold polygonal surface
* meshes. It is implemented in C++ and designed with an
* emphasis on simplicity and efficiency.
*
*----------------------------------------------------------*/
#ifndef EASY3D_PROPERTIES_H
#define EASY3D_PROPERTIES_H
//== INCLUDES =================================================================
#include <vector>
#include <string>
#include <iostream>
#include <algorithm>
#include <typeinfo>
#include <cassert>
//== NAMESPACE ================================================================
namespace easy3d {
//== CLASS DEFINITION =========================================================
class BasePropertyArray
{
public:
/// Default constructor
BasePropertyArray(const std::string& name) : name_(name) {}
/// Destructor.
virtual ~BasePropertyArray() {}
/// Reserve memory for n elements.
virtual void reserve(size_t n) = 0;
/// Resize storage to hold n elements.
virtual void resize(size_t n) = 0;
/// Free unused memory.
virtual void free_memory() = 0;
/// Extend the number of elements by one.
virtual void push_back() = 0;
/// Let two elements swap their storage place.
virtual void swap(size_t i0, size_t i1) = 0;
/// Return a deep copy of self.
virtual BasePropertyArray* clone () const = 0;
/// Return the type_info of the property
virtual const std::type_info& type() = 0;
/// Return the name of the property
const std::string& name() const { return name_; }
protected:
std::string name_;
};
//== CLASS DEFINITION =========================================================
template <class T>
class PropertyArray : public BasePropertyArray
{
public:
typedef T value_type;
typedef std::vector<value_type> vector_type;
typedef typename vector_type::reference reference;
typedef typename vector_type::const_reference const_reference;
PropertyArray(const std::string& name, T t=T()) : BasePropertyArray(name), value_(t) {}
public: // virtual interface of BasePropertyArray
virtual void reserve(size_t n)
{
data_.reserve(n);
}
virtual void resize(size_t n)
{
data_.resize(n, value_);
}
virtual void push_back()
{
data_.push_back(value_);
}
virtual void free_memory()
{
vector_type(data_).swap(data_);
}
virtual void swap(size_t i0, size_t i1)
{
T d(data_[i0]);
data_[i0]=data_[i1];
data_[i1]=d;
}
virtual BasePropertyArray* clone() const
{
PropertyArray<T>* p = new PropertyArray<T>(name_, value_);
p->data_ = data_;
return p;
}
virtual const std::type_info& type() { return typeid(T); }
public:
/// Get pointer to array (does not work for T==bool)
const T* data() const
{
return &data_[0];
}
/// Get reference to the underlying vector
std::vector<T>& vector()
{
return data_;
}
/// Access the i'th element. No range check is performed!
reference operator[](size_t _idx)
{
assert( size_t(_idx) < data_.size() );
return data_[_idx];
}
/// Const access to the i'th element. No range check is performed!
const_reference operator[](size_t _idx) const
{
assert( size_t(_idx) < data_.size());
return data_[_idx];
}
private:
vector_type data_;
value_type value_;
};
// specialization for bool properties
template <>
inline const bool*
PropertyArray<bool>::data() const
{
assert(false);
return nullptr;
}
//== CLASS DEFINITION =========================================================
template <class T>
class Property
{
public:
typedef typename PropertyArray<T>::reference reference;
typedef typename PropertyArray<T>::const_reference const_reference;
friend class PropertyContainer;
public:
Property(PropertyArray<T>* p=nullptr) : parray_(p) {}
void reset()
{
parray_ = nullptr;
}
operator bool() const
{
return parray_ != nullptr;
}
reference operator[](size_t i)
{
assert(parray_ != nullptr);
return (*parray_)[i];
}
const_reference operator[](size_t i) const
{
assert(parray_ != nullptr);
return (*parray_)[i];
}
const T* data() const
{
assert(parray_ != nullptr);
return parray_->data();
}
std::vector<T>& vector()
{
assert(parray_ != nullptr);
return parray_->vector();
}
const std::vector<T>& vector() const
{
assert(parray_ != nullptr);
return parray_->vector();
}
PropertyArray<T>& array()
{
assert(parray_ != nullptr);
return *parray_;
}
const PropertyArray<T>& array() const
{
assert(parray_ != nullptr);
return *parray_;
}
private:
PropertyArray<T>* parray_;
};
//== CLASS DEFINITION =========================================================
class PropertyContainer
{
public:
// default constructor
PropertyContainer() : size_(0) {}
// destructor (deletes all property arrays)
virtual ~PropertyContainer() { clear(); }
// copy constructor: performs deep copy of property arrays
PropertyContainer(const PropertyContainer& _rhs) { operator=(_rhs); }
// assignment: performs deep copy of property arrays
PropertyContainer& operator=(const PropertyContainer& _rhs)
{
if (this != &_rhs)
{
clear();
parrays_.resize(_rhs.n_properties());
size_ = _rhs.size();
for (size_t i=0; i<parrays_.size(); ++i)
parrays_[i] = _rhs.parrays_[i]->clone();
}
return *this;
}
// returns the current size of the property arrays
size_t size() const { return size_; }
// returns the number of property arrays
size_t n_properties() const { return parrays_.size(); }
// returns a vector of all property names
std::vector<std::string> properties() const
{
std::vector<std::string> names;
for (size_t i=0; i<parrays_.size(); ++i)
names.push_back(parrays_[i]->name());
return names;
}
// add a property with name \c name and default value \c t
template <class T> Property<T> add(const std::string& name, const T t=T())
{
// if a property with this name already exists, return an invalid property
for (size_t i=0; i<parrays_.size(); ++i)
{
if (parrays_[i]->name() == name)
{
std::cerr << "[PropertyContainer] A property with name \""
<< name << "\" already exists. Returning invalid property.\n";
return Property<T>();
}
}
// otherwise add the property
PropertyArray<T>* p = new PropertyArray<T>(name, t);
p->resize(size_);
parrays_.push_back(p);
return Property<T>(p);
}
// get a property by its name. returns invalid property if it does not exist.
template <class T> Property<T> get(const std::string& name) const
{
for (size_t i=0; i<parrays_.size(); ++i)
if (parrays_[i]->name() == name)
return Property<T>(dynamic_cast<PropertyArray<T>*>(parrays_[i]));
return Property<T>();
}
// returns a property if it exists, otherwise it creates it first.
template <class T> Property<T> get_or_add(const std::string& name, const T t=T())
{
Property<T> p = get<T>(name);
if (!p) p = add<T>(name, t);
return p;
}
// get the type of property by its name. returns typeid(void) if it does not exist.
const std::type_info& get_type(const std::string& name) const
{
for (size_t i=0; i<parrays_.size(); ++i)
if (parrays_[i]->name() == name)
return parrays_[i]->type();
return typeid(void);
}
// delete a property
template <class T> void remove(Property<T>& h)
{
std::vector<BasePropertyArray*>::iterator it=parrays_.begin(), end=parrays_.end();
for (; it!=end; ++it)
{
if (*it == h.parray_)
{
delete *it;
parrays_.erase(it);
h.reset();
break;
}
}
}
// delete all properties
void clear()
{
for (size_t i=0; i<parrays_.size(); ++i)
delete parrays_[i];
parrays_.clear();
size_ = 0;
}
// reserve memory for n entries in all arrays
void reserve(size_t n) const
{
for (size_t i=0; i<parrays_.size(); ++i)
parrays_[i]->reserve(n);
}
// resize all arrays to size n
void resize(size_t n)
{
for (size_t i=0; i<parrays_.size(); ++i)
parrays_[i]->resize(n);
size_ = n;
}
// free unused space in all arrays
void free_memory() const
{
for (size_t i=0; i<parrays_.size(); ++i)
parrays_[i]->free_memory();
}
// add a new element to each vector
void push_back()
{
for (size_t i=0; i<parrays_.size(); ++i)
parrays_[i]->push_back();
++size_;
}
// swap elements i0 and i1 in all arrays
void swap(size_t i0, size_t i1) const
{
for (size_t i=0; i<parrays_.size(); ++i)
parrays_[i]->swap(i0, i1);
}
private:
std::vector<BasePropertyArray*> parrays_;
size_t size_;
};
//=============================================================================
} // namespace easy3d
//=============================================================================
#endif // EASY3D_PROPERTIES_H
//=============================================================================

View File

@ -1,714 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
/** ----------------------------------------------------------
*
* The code is adapted from libQGLViewer with modifications.
* - libQGLViewer (version Version 2.7.1, Nov 17th, 2017)
* The original code is available at
* http://libqglviewer.com/
*
* libQGLViewer is a C++ library based on Qt that eases the
* creation of OpenGL 3D viewers.
*
*----------------------------------------------------------*/
#ifndef EASY3D_QUATERNION_H
#define EASY3D_QUATERNION_H
#include <easy3d/core/constant.h>
#include <easy3d/core/vec.h>
#include <easy3d/core/mat.h>
/**
* Euler angles VS Quaternion
*
* Euler angles are the easiest way to represent rotation. This representation simply
* stores the three rotation angles around the X, Y and Z axes. These 3 rotations are
* then applied successively, usually in this order: first Y, then Z, then X (but not
* necessarily). Using a different order yields different results.
* Euler angles are usually used to set a character's orientation since game characters
* only rotate on the vertical axis. Therefore, it is easier to write, understand and
* maintain "float direction" than 3 different orientations. Another good use of Euler
* angles is an FPS camera: you have one angle for heading (Y), and one for up/down (X).
* However, when things get more complex, Euler angle will be hard to work with, eg.,:
* - Interpolating smoothly between 2 orientations is hard. Naively interpolating the
* X, Y, and Z angles will be ugly.
* - Applying several rotations is complicated and unprecise: you have to compute the
* final rotation matrix, and guess the Euler angles from this matrix.
* - A well-known problem, the "Gimbal Lock", will sometimes block your rotations, and
* other singularities which will flip your model upside-down.
* - Different angles make the same rotation (-180 and 180 degrees, for instance)
* - It is a mess - as said above, usually the right order is YZX, but if you also use
* a library with a different order, you'll be in trouble.
* - Some operations are complicated, e.g., rotation of N degrees around a specific axis.
* Quaternions are a tool to represent rotations, which solves these problems.
*
*
* The Quaternion class represents 3D rotations and orientations.
*
* The Quaternion is an appropriate (although not very intuitive) representation for
* 3D rotations and orientations. Many tools are provided to ease the definition of a
* Quaternion: see constructors, set_axis_angle(), set_from_rotation_matrix(),
* set_from_rotated_basis().
*
* You can apply the rotation represented by the Quaternion to 3D points using rotate()
* and inverse_rotate().
*
* You can apply the Quaternion q rotation to the OpenGL matrices using
* glMultMatrixd(q.matrix());
* which is equvalent to
* glRotate(q.angle()*180.0/M_PI, q.axis().x, q.axis().y, q.axis().z);
*
* Internal representation
* The internal representation of a Quaternion is a set of 4 numbers, [x y z w], which
* represents rotations the following way:
* x = axis.x * sin(angle / 2)
* y = axis.y * sin(angle / 2)
* z = axis.z * sin(angle / 2)
* w = cos(angle / 2)
* NOTE:
* - the angle is in radians and the axis is a unit vector.
* - certain implementations place the cosine term in the first position (instead of last).
*
* A Quaternion is always normalized, so that its inverse() is actually its conjugate.
*/
namespace easy3d {
template <typename FT>
class Quat
{
public:
typedef Vec<3, FT> Vec3;
typedef Quat<FT> thisclass;
public:
/* Defining a Quat */
/* Default constructor, builds an identity rotation. */
Quat()
{
_q[0] = _q[1] = _q[2] = FT(0); _q[3] = FT(1);
}
/* Constructor from rotation axis (non null) and angle (in radians). See also set_axis_angle(). */
Quat(const Vec3& axis, FT angle)
{
set_axis_angle(axis, angle);
}
/* Constructs a Quaternion that will rotate from the \p from direction to the \p to direction.
Note that this rotation is not uniquely defined. The selected axis is usually orthogonal to \p from
and \p to, minimizing the rotation angle. This method is robust and can handle small or almost identical vectors. */
Quat(const Vec3& from, const Vec3& to);
/* Constructor from the four values of a Quaternion. First three values are axis*sin(angle/2) and
last one is cos(angle/2).
\attention The identity Quaternion is Quat(0,0,0,1) and not Quat(0,0,0,0) (which is
not unitary). The default Quat() creates such identity Quaternion. */
Quat(FT q0, FT q1, FT q2, FT q3)
{ _q[0]=q0; _q[1]=q1; _q[2]=q2; _q[3]=q3; }
/* Copy constructor. */
Quat(const thisclass& Q)
{ for (int i=0; i<4; ++i) _q[i] = Q._q[i]; }
/* Equal operator. */
Quat& operator=(const thisclass& Q) {
for (int i=0; i<4; ++i)
_q[i] = Q._q[i];
return (*this);
}
/* Sets the Quaternion as a rotation of axis and angle (in radians).
\p axis does not need to be normalized. A null axis will result in an identity Quaternion. */
void set_axis_angle(const Vec3& axis, FT angle);
/* Sets the Quaternion value. */
void set_value(FT q0, FT q1, FT q2, FT q3)
{ _q[0]=q0; _q[1]=q1; _q[2]=q2; _q[3]=q3; }
/* Set the Quaternion from a (supposedly correct) 3x3 rotation matrix.
The matrix is expressed in European format: its three columns are the images by the rotation of
the three vectors of an orthogonal basis. */
// see http://www.euclideanspace.com/maths/geometry/rotations/conversions/matrixToQuaternion/index.htm
void set_from_rotation_matrix(const Mat3<FT>& m);
/* set_from_rotated_basis() sets a Quaternion from the three axis of a rotated frame. It actually fills
the three columns of a matrix with these rotated basis vectors and calls this method. */
void set_from_rotated_basis(const Vec3& X, const Vec3& Y, const Vec3& Z);
/* Returns the normalized axis direction of the rotation represented by the Quaternion.
It is null for an identity Quaternion. See also angle() and get_axis_angle(). */
Vec3 axis() const;
/* Returns the angle (in radians) of the rotation represented by the Quaternion.
This value is always in the range [0-pi]. Larger rotational angles are obtained by inverting the
axis() direction. See also axis() and get_axis_angle(). */
FT angle() const;
/* Returns the axis vector and the angle (in radians) of the rotation represented by the Quaternion.*/
void get_axis_angle(Vec3& axis, FT& angle) const;
/* Bracket operator, with a constant return value. i must range in [0..3]. */
FT operator[](int i) const { return _q[i]; }
/* Bracket operator returning an l-value. i must range in [0..3]. */
FT& operator[](int i) { return _q[i]; }
/* Rotation computations */
/* Returns the composition of the a and b rotations.
The order is important. When applied to a Vec v (see operator*(const Quaternion&, const Vec&)
and rotate()) the resulting Quaternion acts as if b was applied first and then a was applied.
This is obvious since the image v' of v by the composited rotation satisfies:
v'= (a*b) * v = a * (b*v)
Note that a*b usually differs from b*a.
\attention For efficiency reasons, the resulting Quaternion is not normalized. Use normalize() in
case of numerical drift with small rotation composition. */
friend Quat operator*(const Quat& a, const Quat& b)
{
return Quat(
a._q[3]*b._q[0] + b._q[3]*a._q[0] + a._q[1]*b._q[2] - a._q[2]*b._q[1],
a._q[3]*b._q[1] + b._q[3]*a._q[1] + a._q[2]*b._q[0] - a._q[0]*b._q[2],
a._q[3]*b._q[2] + b._q[3]*a._q[2] + a._q[0]*b._q[1] - a._q[1]*b._q[0],
a._q[3]*b._q[3] - b._q[0]*a._q[0] - a._q[1]*b._q[1] - a._q[2]*b._q[2]
);
}
/* Quaternion rotation is composed with q.
See operator*(), since this is equivalent to this = this * q.
\note For efficiency reasons, the resulting Quaternion is not normalized.
You may normalize() it after each application in case of numerical drift. */
Quat& operator*=(const Quat &q) {
*this = (*this)*q;
return *this;
}
/* Returns the image of v by the rotation q.
Same as q.rotate(v). See rotate() and inverse_rotate(). */
friend Vec3 operator*(const Quat& q, const Vec3& v) { return q.rotate(v); }
/* Returns the image of v by the Quaternion rotation.
See also inverse_rotate() and operator*(const Quat&, const Vec&). */
Vec3 rotate(const Vec3& v) const;
/* Returns the image of v by the Quaternion inverse() rotation.
rotate() performs an inverse transformation. Same as inverse().rotate(v). */
Vec3 inverse_rotate(const Vec3& v) const {
return inverse().rotate(v);
}
/* Inversion */
/* Returns the inverse Quaternion (inverse rotation).
Result has a negated axis() direction and the same angle(). A composition (see operator*()) of a
Quaternion and its inverse() results in an identity function.
Use invert() to actually modify the Quaternion. */
Quat inverse() const { return Quat(-_q[0], -_q[1], -_q[2], _q[3]); }
/* Inverses the Quaternion (same rotation angle(), but negated axis()).
See also inverse(). */
void invert() { _q[0] = -_q[0]; _q[1] = -_q[1]; _q[2] = -_q[2]; }
/* Negates all the coefficients of the Quaternion.
This results in an other representation of the same rotation (opposite rotation angle, but with
a negated axis direction: the two cancel out). However, note that the results of axis() and
angle() are unchanged after a call to this method since angle() always returns a value in [0,pi].
This method is mainly useful for Quaternion interpolation, so that the spherical interpolation
takes the shortest path on the unit sphere. See slerp() for details. */
void negate() { invert(); _q[3] = -_q[3]; }
FT length() const {
return std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2] + _q[3] * _q[3]);
}
/* Normalizes the Quaternion coefficients.
This method should not need to be called since we only deal with unit Quaternions. This is however
useful to prevent numerical drifts, especially with small rotational increments. See also
normalized(). */
FT normalize() {
const FT norm = std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2] + _q[3] * _q[3]);
for (int i=0; i<4; ++i)
_q[i] /= norm;
return norm;
}
/* Returns a normalized version of the Quaternion.
See also normalize(). */
Quat normalized() const {
FT Q[4];
const FT norm = std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2] + _q[3] * _q[3]);
for (int i=0; i<4; ++i)
Q[i] = _q[i] / norm;
return Quat(Q[0], Q[1], Q[2], Q[3]);
}
/* Returns the Quaternion associated 4x4 rotation matrix.
Use glMultMatrixf(q.matrix()) to apply the rotation represented by Quaternion q to the
current OpenGL matrix. */
Mat4<FT> matrix() const;
/* Returns the associated 4x4 inverse rotation matrix. This is simply the matrix() of the inverse().*/
Mat4<FT> inverse_matrix() const;
/* Interpolate between 2 quaternions */
/* Slerp(Spherical Linear intERPolation) interpolation */
/* Returns the slerp interpolation of Quaternions a and b, at time t. t should range in [0,1].
Result is a when t=0 and b when t=1.
When allowFlip is true (default) the slerp interpolation will always use the "shortest path" between
the Quaternions' orientations, by "flipping" the source Quaternion if needed (see negate()). */
static Quat slerp(const Quat<FT>& a, const Quat<FT>& b, FT t, bool allowFlip = true);
/* Returns the slerp interpolation of the two Quaternions a and b, at time t, using tangents tgA and tgB.
The resulting Quaternion is "between" a and b (result is a when t=0 and b for t=1).
Use squad_tangent() to define the Quaternion tangents tgA and tgB. */
static Quat squad(const Quat<FT>& a, const Quat<FT>& tgA, const Quat<FT>& tgB, const Quat<FT>& b, FT t);
/* Returns the "dot" product of a and b: a[0]*b[0] + a[1]*b[1] + a[2]*b[2] + a[3]*b[3]. */
static FT dot(const Quat<FT>& a, const Quat<FT>& b) { return a[0] * b[0] + a[1] * b[1] + a[2] * b[2] + a[3] * b[3]; }
/* Returns the logarithm of the Quaternion. See also exp(). */
Quat log();
/* Returns the exponential of the Quaternion. See also log(). */
Quat exp();
/* Returns log(a. inverse() * b). Useful for squad_tangent(). */
static Quat ln_dif(const Quat<FT>& a, const Quat<FT>& b);
/* Returns a tangent Quaternion for \p center, defined by \p before and \p after Quaternions.
Useful for smooth spline interpolation of Quaternion with squad() and slerp(). */
static Quat squad_tangent(const Quat<FT>& before, const Quat<FT>& center, const Quat<FT>& after);
/* Returns a random unit Quaternion.
You can create a randomly directed unit vector using:
Vec randomDir = Quat::random_quat() * Vec(1.0, 0.0, 0.0); // or any other Vec
\note This function uses rand() to create pseudo-random numbers and the random number generator can
be initialized using srand().*/
static thisclass random_quat();
//data intentionally left public to allow q.x ...
public:
/* The internal data representation is private, use operator[] to access values. */
union {
struct { FT x; FT y; FT z; FT w; };
FT _q[4];
};
};
template <typename FT> std::ostream& operator<<(std::ostream& os, const Quat<FT>& q);
template <typename FT> std::istream& operator>>(std::istream& is, Quat<FT>& q);
//-------------- implementation -----------------
template <typename FT>
Quat<FT>::Quat(const Vec3& from, const Vec3& to)
{
const FT epsilon = FT(1E-10);
const FT fromSqNorm = from.length2();
const FT toSqNorm = to.length2();
// Identity Quaternion when one vector is null
if ((fromSqNorm < epsilon) || (toSqNorm < epsilon))
{
_q[0] = _q[1] = _q[2] = 0.0;
_q[3] = 1.0;
}
else
{
Vec3 axis = cross(from, to);
const FT axisSqNorm = axis.length2();
// Aligned vectors, pick any axis, not aligned with from or to
if (axisSqNorm < epsilon)
axis = orthogonal(from);
FT angle = std::asin(std::sqrt(axisSqNorm / (fromSqNorm * toSqNorm)));
if (easy3d::dot(from, to) < 0.0)
angle = FT(M_PI - angle);
set_axis_angle(axis, angle);
}
}
template <typename FT>
void Quat<FT>::set_axis_angle(const Vec3& axis, FT angle)
{
const FT norm = axis.length();
if (norm < 1E-8)
{
// Null rotation
_q[0] = FT(0); _q[1] = FT(0); _q[2] = FT(0); _q[3] = FT(1);
}
else
{
const FT sin_half_angle = std::sin(angle / 2.0f);
_q[0] = sin_half_angle*axis[0] / norm;
_q[1] = sin_half_angle*axis[1] / norm;
_q[2] = sin_half_angle*axis[2] / norm;
_q[3] = (FT)std::cos(angle / 2.0f);
}
}
template <typename FT>
typename Quat<FT>::Vec3 Quat<FT>::rotate(const Vec3& v) const
{
const FT q00 = FT(2.0l * _q[0] * _q[0]);
const FT q11 = FT(2.0l * _q[1] * _q[1]);
const FT q22 = FT(2.0l * _q[2] * _q[2]);
const FT q01 = FT(2.0l * _q[0] * _q[1]);
const FT q02 = FT(2.0l * _q[0] * _q[2]);
const FT q03 = FT(2.0l * _q[0] * _q[3]);
const FT q12 = FT(2.0l * _q[1] * _q[2]);
const FT q13 = FT(2.0l * _q[1] * _q[3]);
const FT q23 = FT(2.0l * _q[2] * _q[3]);
return Vec3(
FT((1.0 - q11 - q22)*v[0] + (q01 - q23)*v[1] + (q02 + q13)*v[2]),
FT((q01 + q23)*v[0] + (1.0 - q22 - q00)*v[1] + (q12 - q03)*v[2]),
FT((q02 - q13)*v[0] + (q12 + q03)*v[1] + (1.0 - q11 - q00)*v[2]));
}
template <typename FT>
void Quat<FT>::set_from_rotation_matrix(const Mat3<FT>& m)
{
// see http://www.euclideanspace.com/maths/geometry/rotations/conversions/matrixToQuaternion/index.htm
// Compute one plus the trace of the matrix
const FT onePlusTrace = FT(1.0) + m(0, 0) + m(1, 1) + m(2, 2);
if (onePlusTrace > 1E-5) {
// Direct computation
const FT s = std::sqrt(onePlusTrace) * FT(2.0);
_q[0] = (m(2, 1) - m(1, 2)) / s;
_q[1] = (m(0, 2) - m(2, 0)) / s;
_q[2] = (m(1, 0) - m(0, 1)) / s;
_q[3] = FT(0.25) * s;
}
else
{
// Computation depends on major diagonal term
if ((m(0, 0) > m(1, 1)) && (m(0, 0) > m(2, 2))) {
const FT s = std::sqrt(FT(1.0) + m(0, 0) - m(1, 1) - m(2, 2)) * FT(2.0);
_q[0] = FT(0.25) * s;
_q[1] = (m(0, 1) + m(1, 0)) / s;
_q[2] = (m(0, 2) + m(2, 0)) / s;
_q[3] = (m(1, 2) - m(2, 1)) / s;
}
else if (m(1, 1) > m(2, 2)) {
const FT s = std::sqrt(FT(1.0) + m(1, 1) - m(0, 0) - m(2, 2)) * FT(2.0);
_q[0] = (m(0, 1) + m(1, 0)) / s;
_q[1] = FT(0.25) * s;
_q[2] = (m(1, 2) + m(2, 1)) / s;
_q[3] = (m(0, 2) - m(2, 0)) / s;
}
else {
const FT s = std::sqrt(FT(1.0) + m(2, 2) - m(0, 0) - m(1, 1)) * FT(2.0);
_q[0] = (m(0, 2) + m(2, 0)) / s;
_q[1] = (m(1, 2) + m(2, 1)) / s;
_q[2] = FT(0.25) * s;
_q[3] = (m(0, 1) - m(1, 0)) / s;
}
}
normalize();
}
template <typename FT>
void Quat<FT>::set_from_rotated_basis(const Vec3& X, const Vec3& Y, const Vec3& Z)
{
Mat3<FT> m;
FT normX = X.length();
FT normY = Y.length();
FT normZ = Z.length();
for (int i = 0; i < 3; ++i) {
m(i, 0) = X[i] / normX;
m(i, 1) = Y[i] / normY;
m(i, 2) = Z[i] / normZ;
}
set_from_rotation_matrix(m);
}
template <typename FT>
void Quat<FT>::get_axis_angle(Vec3& axis, FT& angle) const
{
// The normalize() is here to prevent failure introduced by numerical error.
// We call std::acos(_q[3]), but _q[3] equaling to 1 can actually be e.g., 1.00000012.
if (_q[3] > FT(1)) {
const_cast<Quat*>(this)->normalize();
}
angle = FT(2.0) * std::acos(_q[3]);
axis = Vec3(_q[0], _q[1], _q[2]);
const FT sinus = axis.length();
if (sinus > 1E-8)
axis = axis / sinus;
if (angle > M_PI) {
angle = 2.0*M_PI - angle;
axis = -axis;
}
}
template <typename FT>
typename Quat<FT>::Vec3 Quat<FT>::axis() const
{
Vec3 res(_q[0], _q[1], _q[2]);
const FT sinus = res.length();
if (sinus > 1E-8)
res = res / sinus;
// The normalize() is here to prevent failure introduced by numerical error.
// We call std::acos(_q[3]), but _q[3] equaling to 1 can actually be e.g., 1.00000012.
if (_q[3] > FT(1)) {
const_cast<Quat*>(this)->normalize();
}
return (std::acos(_q[3]) <= M_PI / 2.0) ? res : -res;
}
template <typename FT>
FT Quat<FT>::angle() const
{
// The normalize() is here to prevent failure introduced by numerical error.
// We call std::acos(_q[3]), but _q[3] equaling to 1 can actually be e.g., 1.00000012.
if (_q[3] > FT(1)) {
const_cast<Quat*>(this)->normalize();
}
const FT angle = FT(2.0) * std::acos(_q[3]);
return (angle <= M_PI) ? angle : FT(2.0*M_PI - angle);
}
//Mat4 quat_to_matrix(const Quat& q)
//{
// Mat4 M;
//
// const double x = q.vector()[0];
// const double y = q.vector()[1];
// const double z = q.vector()[2];
// const double w = q.scalar();
// const double s = 2 / norm(q);
//
// M(0, 0) = 1 - s*(y*y + z*z); M(0, 1) = s*(x*y - w*z); M(0, 2) = s*(x*z + w*y); M(0, 3) = 0;
// M(1, 0) = s*(x*y + w*z); M(1, 1) = 1 - s*(x*x + z*z); M(1, 2) = s*(y*z - w*x); M(1, 3) = 0;
// M(2, 0) = s*(x*z - w*y); M(2, 1) = s*(y*z + w*x); M(2, 2) = 1 - s*(x*x + y*y); M(2, 3) = 0;
// M(3, 0) = 0; M(3, 1) = 0; M(3, 2) = 0; M(3, 3) = 1;
//
// return M;
//}
//
//Mat4 unit_quat_to_matrix(const Quat& q)
//{
// Mat4 M;
//
// const double x = q.vector()[0];
// const double y = q.vector()[1];
// const double z = q.vector()[2];
// const double w = q.scalar();
//
// M(0, 0) = 1 - 2 * (y*y + z*z); M(0, 1) = 2 * (x*y - w*z); M(0, 2) = 2 * (x*z + w*y); M(0, 3) = 0;
// M(1, 0) = 2 * (x*y + w*z); M(1, 1) = 1 - 2 * (x*x + z*z); M(1, 2) = 2 * (y*z - w*x); M(1, 3) = 0;
// M(2, 0) = 2 * (x*z - w*y); M(2, 1) = 2 * (y*z + w*x); M(2, 2) = 1 - 2 * (x*x + y*y); M(2, 3) = 0;
// M(3, 0) = 0; M(3, 1) = 0; M(3, 2) = 0; M(3, 3) = 1;
//
// return M;
//}
template <typename FT>
Mat4<FT> Quat<FT>::matrix() const
{
const FT q00 = FT(2.0l * _q[0] * _q[0]);
const FT q11 = FT(2.0l * _q[1] * _q[1]);
const FT q22 = FT(2.0l * _q[2] * _q[2]);
const FT q01 = FT(2.0l * _q[0] * _q[1]);
const FT q02 = FT(2.0l * _q[0] * _q[2]);
const FT q03 = FT(2.0l * _q[0] * _q[3]);
const FT q12 = FT(2.0l * _q[1] * _q[2]);
const FT q13 = FT(2.0l * _q[1] * _q[3]);
const FT q23 = FT(2.0l * _q[2] * _q[3]);
Mat4<FT> m;
m(0, 0) = FT(1.0) - q11 - q22;
m(0, 1) = q01 - q23;
m(0, 2) = q02 + q13;
m(1, 0) = q01 + q23;
m(1, 1) = FT(1.0) - q22 - q00;
m(1, 2) = q12 - q03;
m(2, 0) = q02 - q13;
m(2, 1) = q12 + q03;
m(2, 2) = FT(1.0) - q11 - q00;
m(3, 0) = FT(0.0);
m(3, 1) = FT(0.0);
m(3, 2) = FT(0.0);
m(0, 3) = FT(0.0);
m(1, 3) = FT(0.0);
m(2, 3) = FT(0.0);
m(3, 3) = FT(1.0);
return m;
}
template <typename FT>
Mat4<FT> Quat<FT>::inverse_matrix() const
{
return inverse().matrix();
}
template <typename FT>
Quat<FT> Quat<FT>::slerp(const Quat<FT>& a, const Quat<FT>& b, FT t, bool allowFlip)
{
FT cosAngle = Quat<FT>::dot(a, b);
FT c1, c2;
// Linear interpolation for close orientations
if ((1.0 - std::fabs(cosAngle)) < 0.01)
{
c1 = FT(1.0) - t;
c2 = t;
}
else
{
// Spherical interpolation
FT angle = std::acos(std::fabs(cosAngle));
FT sinAngle = std::sin(angle);
c1 = std::sin(angle * (1.0 - t)) / sinAngle;
c2 = std::sin(angle * t) / sinAngle;
}
// Use the shortest path
if (allowFlip && (cosAngle < 0.0))
c1 = -c1;
return Quat(c1*a[0] + c2*b[0], c1*a[1] + c2*b[1], c1*a[2] + c2*b[2], c1*a[3] + c2*b[3]);
}
template <typename FT>
Quat<FT> Quat<FT>::squad(const Quat<FT>& a, const Quat<FT>& tgA, const Quat<FT>& tgB, const Quat<FT>& b, FT t)
{
Quat<FT> ab = Quat<FT>::slerp(a, b, t);
Quat<FT> tg = Quat<FT>::slerp(tgA, tgB, t, false);
return Quat<FT>::slerp(ab, tg, 2.0*t*(1.0 - t), false);
}
template <typename FT>
Quat<FT> Quat<FT>::log()
{
FT len = std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2]);
if (len < 1E-6)
return Quat(_q[0], _q[1], _q[2], 0.0);
else
{
// The normalize() is here to prevent failure introduced by numerical error.
// We call std::acos(_q[3]), but _q[3] equaling to 1 can actually be e.g., 1.00000012.
if (_q[3] > FT(1)) {
const_cast<Quat*>(this)->normalize();
} FT coef = std::acos(_q[3]) / len;
return Quat(_q[0] * coef, _q[1] * coef, _q[2] * coef, 0.0);
}
}
template <typename FT>
Quat<FT> Quat<FT>::exp()
{
FT theta = std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2]);
if (theta < 1E-6)
return Quat(_q[0], _q[1], _q[2], std::cos(theta));
else
{
FT coef = std::sin(theta) / theta;
return Quat(_q[0] * coef, _q[1] * coef, _q[2] * coef, std::cos(theta));
}
}
template <typename FT>
Quat<FT> Quat<FT>::ln_dif(const Quat& a, const Quat& b)
{
Quat<FT> dif = a.inverse()*b;
dif.normalize();
return dif.log();
}
template <typename FT>
Quat<FT> Quat<FT>::squad_tangent(const Quat<FT>& before, const Quat<FT>& center, const Quat<FT>& after)
{
Quat<FT> l1 = Quat<FT>::ln_dif(center, before);
Quat<FT> l2 = Quat<FT>::ln_dif(center, after);
Quat<FT> e;
for (int i = 0; i < 4; ++i)
e._q[i] = -0.25 * (l1._q[i] + l2._q[i]);
e = center*(e.exp());
// if (Quat<FT>::dot(e,b) < 0.0)
// e.negate();
return e;
}
template <typename FT>
Quat<FT> Quat<FT>::random_quat()
{
// The rand() function is not very portable and may not be available on your system.
// Add the appropriate include or replace by an other random function in case of problem.
FT seed = rand() / (FT)RAND_MAX;
FT r1 = std::sqrt(1.0f - seed);
FT r2 = std::sqrt(seed);
FT t1 = 2.0f * M_PI * (rand() / (FT)RAND_MAX);
FT t2 = 2.0f * M_PI * (rand() / (FT)RAND_MAX);
return Quat(std::sin(t1)*r1, std::cos(t1)*r1, std::sin(t2)*r2, std::cos(t2)*r2);
}
template <typename FT> inline
std::ostream& operator<<(std::ostream& os, const Quat<FT>& Q)
{
return os << Q[0] << ' ' << Q[1] << ' ' << Q[2] << ' ' << Q[3];
}
template <typename FT> inline
std::istream& operator>>(std::istream& is, Quat<FT>& Q) {
return is >> Q[0] >> Q[1] >> Q[2] >> Q[3];
}
}
#endif // EASY3D_QUATERNION_H

View File

@ -1,63 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_RANDOM_H
#define EASY3D_RANDOM_H
#include <random>
#include <easy3d/core/types.h>
namespace easy3d {
/* Random real in [0, 1]. */
inline float random_float() {
return float(std::rand()) / float(RAND_MAX);
}
/* Random real number in the range [min, max] */
inline float random_float(float min, float max) {
return min + random_float() * (max - min);
}
inline vec3 random_color(bool allow_dark = false) {
float min_rgb = 0.3f;
if (allow_dark)
min_rgb = 0.0f;
return vec3(
random_float(min_rgb, 1.0f),
random_float(min_rgb, 1.0f),
random_float(min_rgb, 1.0f)
);
}
}
#endif // EASY3D_RANDOM_H

View File

@ -1,94 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_RECTANGLE_H
#define EASY3D_RECTANGLE_H
#include <algorithm>
#include <easy3d/core/vec.h>
namespace easy3d {
// Seems duplicating 2D bounding box?
template <typename FT>
class GenericRect {
public:
GenericRect(const Vec<2, FT>& p, const Vec<2, FT>& q) {
x_min_ = std::min(q.x, p.x);
y_min_ = std::min(q.y, p.y);
x_max_ = std::max(q.x, p.x);
y_max_ = std::max(q.x, p.y);
}
GenericRect(FT xmin, FT xmax, FT ymin, FT ymax)
: x_min_(xmin)
, x_max_(xmax)
, y_min_(ymin)
, y_max_(ymax)
{
}
FT x_min() const { return x_min_; }
FT y_min() const { return y_min_; }
FT x_max() const { return x_max_; }
FT y_max() const { return y_max_; }
FT x() const { return x_min_; }
FT y() const { return y_min_; }
FT width() const { return x_max() - x_min(); }
FT height() const { return y_max() - y_min(); }
FT left() const { return x_min_; }
FT top() const { return y_min_; }
FT right() const { return x_max_; }
FT bottom() const { return y_max_; }
Vec<2, FT> top_left() const { return Vec<2, FT>(x_min_, y_min_); }
Vec<2, FT> bottom_right() const { return Vec<2, FT>(x_max_, y_max_); }
Vec<2, FT> top_right() const { return Vec<2, FT>(x_max_, y_min_); }
Vec<2, FT> bottom_left() const { return Vec<2, FT>(x_min_, y_max_); }
Vec<2, FT> min() const { return Vec<2, FT>(x_min_, y_min_); }
Vec<2, FT> max() const { return Vec<2, FT>(x_max_, y_max_); }
Vec<2, FT> center() const {
return Vec<2, FT>(FT(0.5) * (x_max() + x_min()), FT(0.5) * (y_max() + y_min()));
}
private:
FT x_min_;
FT y_min_;
FT x_max_;
FT y_max_;
};
}
#endif // EASY3D_RECTANGLE_H

View File

@ -1,116 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_SEGMENT_H
#define EASY3D_SEGMENT_H
#include <algorithm>
#include <easy3d/core/vec.h>
#include <easy3d/core/line.h>
namespace easy3d {
template <int DIM, typename FT>
class GenericSegment {
public:
typedef Vec<DIM, FT> Point;
typedef Vec<DIM, FT> Vector;
typedef GenericLine<DIM, FT> Line;
typedef GenericSegment<DIM, FT> thisclass;
public:
GenericSegment(const Point& s, const Point& t);
GenericSegment() {}
const Point& source() const { return s_; }
const Point& target() const { return t_; }
void set_source(const Point& s) { s_ = s; }
void set_target(const Point& t) { t_ = t; }
Line supporting_line() const { return Line::from_two_points(s_, t_); }
Vector to_vector() const { return t_ - s_; }
// the projection of p on the supporting line
Point projection(const Point &p) const;
// test if the projection of p is inside the two end points
bool projected_inside(const Point& p) const;
FT squared_ditance(const Point &p) const;
private:
Point s_;
Point t_;
};
template<int DIM, typename FT> inline
GenericSegment<DIM, FT>::GenericSegment(const Point& s, const Point& t) : s_(s), t_(t) {
#ifndef NDEBUG // degenerate case
if (distance2(s, t) < 1e-15) {
std::cerr << "degenerate segment constructed from 2 points:" << std::endl
<< "\t(" << s << ")" << std::endl
<< "\t(" << t << ")" << std::endl;
}
#endif
}
template<int DIM, typename FT> inline
typename GenericSegment<DIM, FT>::Point GenericSegment<DIM, FT>::projection(const Point &p) const {
Vector dir = normalize(t_ - s_);
return (s_ + dir * dot(p - s_, dir));
}
template<int DIM, typename FT> inline
bool GenericSegment<DIM, FT>::projected_inside(const Point& p) const {
return (dot(s_ - p, t_ - p) < 0);
}
template<int DIM, typename FT> inline
FT GenericSegment<DIM, FT>::squared_ditance(const Point &p) const {
if (projected_inside(p))
return distance2(projection(p), p);
else {
FT ds = distance2(s_, p);
FT dt = distance2(t_, p);
return std::min(ds, dt);
}
}
}
#endif // EASY3D_SEGMENT_H

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -1,228 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_TYPES_H
#define EASY3D_TYPES_H
#include <cstdint>
#include <easy3d/core/vec.h>
#include <easy3d/core/mat.h>
#include <easy3d/core/rect.h>
#include <easy3d/core/line.h>
#include <easy3d/core/segment.h>
#include <easy3d/core/plane.h>
#include <easy3d/core/box.h>
#include <easy3d/core/quat.h>
/**
* Gathers different basic types for geometric operations.
* Types defined here are points/vectors, lines, segments,
* planes, boxes and matrices in 2D and 3D.
*/
namespace easy3d {
//____________________ default types___________________
typedef Vec<2, float> vec2;
typedef Vec<3, float> vec3;
typedef Vec<4, float> vec4;
typedef Vec<2, double> dvec2;
typedef Vec<3, double> dvec3;
typedef Vec<4, double> dvec4;
typedef Vec<2, int32_t> ivec2;
typedef Vec<3, int32_t> ivec3;
typedef Vec<4, int32_t> ivec4;
typedef Mat2<float> mat2;
typedef Mat3<float> mat3;
typedef Mat4<float> mat4;
typedef Mat<3, 4, float> mat34;
typedef Mat<4, 3, float> mat43;
typedef Mat2<double> dmat2;
typedef Mat3<double> dmat3;
typedef Mat4<double> dmat4;
typedef Mat<3, 4, double> dmat34;
typedef Mat<4, 3, double> dmat43;
typedef Quat<float> quat;
typedef Quat<double> dquat;
typedef GenericLine<2, float> Line2;
typedef GenericLine<3, float> Line3;
typedef GenericSegment<2, float> Segment2;
typedef GenericSegment<3, float> Segment3;
typedef GenericPlane<float> Plane3;
typedef GenericBox<2, float> Box2;
typedef GenericBox<3, float> Box3;
typedef GenericRect<float> Rect;
typedef GenericRect<int32_t> iRect;
namespace geom {
/* Returns a vector orthogonal to v. Its norm() depends on v, but is zero only for a null v.*/
inline vec3 orthogonal(const vec3& v) {
float absx = std::fabs(v.x);
float absy = std::fabs(v.y);
float absz = std::fabs(v.z);
// Find smallest component. Keep equal case for null values.
if ((absy >= absx) && (absz >= absx))
return vec3(0.0, -v.z, v.y);
else {
if ((absx >= absy) && (absz >= absy))
return vec3(-v.z, 0.0f, v.x);
else
return vec3(-v.y, v.x, 0.0f);
}
}
// bounding box for 3D/2D point set
template <typename Box, typename InputIterator >
inline Box bounding_box(InputIterator first, InputIterator last) {
assert(first != last);
Box result;
for (InputIterator it = first; it != last; ++it) {
result.add_point(*it);
}
return result;
}
// centroid for 3D/2D point set
template <typename Vec, typename InputIterator >
inline Vec centroid(InputIterator begin, InputIterator end) {
assert(begin != end);
Vec v;
unsigned int nb_pts = 0;
for (InputIterator it = begin; it != end; ++it) {
v += (*it);
++nb_pts;
}
return v / nb_pts;
}
template < typename Vec >
inline Vec barycenter(const Vec& p1, const Vec& p2) {
return (p1 + p2) * 0.5f;
}
template < typename Vec >
inline Vec barycenter(const Vec& p1, const Vec& p2, const Vec& p3) {
return (p1 + p2 + p3) / 3.0f;
}
template < typename Vec >
inline Vec barycenter(const Vec& p1, const Vec& p2, const Vec& p3, const Vec& p4) {
return (p1 + p2 + p3 + p4) * 0.25f;
}
inline float cos_angle(const vec3& a, const vec3& b) {
float na2 = length2(a);
float nb2 = length2(b);
return dot(a, b) / ::sqrt(na2 * nb2);
}
inline float angle(const vec3& a, const vec3& b) {
return std::acos(cos_angle(a, b));
}
inline float cos_angle(const vec2& a, const vec2& b) {
float na2 = length2(a);
float nb2 = length2(b);
return dot(a, b) / std::sqrt(na2 * nb2);
}
inline float det(const vec2& a, const vec2& b) {
return a.x*b.y - a.y*b.x;
}
/* returns the angle in the interval [-pi .. pi] */
inline float angle(const vec2& a, const vec2& b) {
return det(a, b) > 0 ?
std::acos(cos_angle(a, b)) :
-std::acos(cos_angle(a, b));
}
// round the given floating point number v to be num_digits.
// TODO: this function should not be in this file.
template <class T>
T truncate_digits(const T& v, int num_digits) {
T tmp = std::pow(10.0f, num_digits);
long long des = static_cast<long long>((v < 0) ? (v * tmp - 0.5f) : (v * tmp + 0.5f));
T result = T(des) / tmp;
return result;
}
// radians
template <typename T>
inline T to_radians(T degrees) {
return degrees * static_cast<T>(0.01745329251994329576923690768489);
}
// degrees
template <typename T>
inline T to_degrees(T radians) {
return radians * static_cast<T>(57.295779513082320876798154814105);
}
inline float triangle_area(
const vec3& p1, const vec3& p2, const vec3& p3
) {
return 0.5f * length(cross(p2 - p1, p3 - p1));
}
inline float triangle_signed_area(
const vec2& p1, const vec2& p2, const vec2& p3
) {
return 0.5f * det(p2 - p1, p3 - p1);
}
inline vec3 triangle_normal(
const vec3& p1, const vec3& p2, const vec3& p3
) {
vec3 n = cross(p2 - p1, p3 - p2);
return normalize(n);
}
} // namespace Geom
}
#endif // EASY3D_TYPES_H

View File

@ -1,745 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef EASY3D_VEC_H
#define EASY3D_VEC_H
#include <cassert>
#include <iostream>
#include <cmath>
#include <cfloat>
#include <limits>
namespace easy3d {
#if 1
template <size_t N, class T>
class Vec {
public:
typedef Vec<N, T> thisclass;
Vec() { for (size_t i = 0; i < N; i++) { data_[i] = T(0); } }
explicit Vec(const T& s) { for (size_t i = 0; i < N; i++) { data_[i] = s; } }
// This one should never be called : a template constructor cannot be a copy constructor
template<class T2> explicit Vec(const Vec<N, T2>& rhs) {
for (size_t i = 0; i < N; i++) {
data_[i] = T(rhs[i]);
}
}
// to avoid compilation problems
template<class T2, size_t M> explicit Vec(const Vec<M, T2>& rhs) {
assert(M == N);
for (size_t i = 0; i < N; i++) {
data_[i] = T(rhs[i]);
}
}
template<class T2> explicit Vec(const T2* rhs) {
for (size_t i = 0; i < N; i++) {
data_[i] = T(rhs[i]);
}
}
thisclass& operator=(const thisclass& rhs) {
memcpy(data_, rhs.data(), N*sizeof(T));
return *this;
}
size_t dimension() const { return (size_t)N; }
size_t size() const { return dimension(); }
// returns the memory address of the vector.
T* data() { return data_; }
const T* data() const { return data_; }
// Conversion operator returning the memory address of the data.
// Very convenient to pass the data pointer as a parameter to functions.
// e.g., glVertex3fv(pos);
operator const T*() const { return data_; }
operator T*() { return data_; }
inline T& operator[](int idx) {
assert(idx < N);
return data()[idx];
}
inline const T& operator[](int idx) const {
assert(idx < N);
return data()[idx];
}
inline T length2() const {
T result = T(0);
for (size_t i = 0; i < N; i++) {
result += data_[i] * data_[i];
}
return result;
}
inline T length() const {
return sqrt(length2());
}
inline T norm() const {
return length();
}
inline T distance2(const thisclass &rhs) const {
T result = T(0);
for (size_t i = 0; i < N; i++) {
T val = rhs.data_[i] - data_[i];
result += val*val;
}
return result;
}
inline thisclass& normalize() {
T s = length();
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
*this *= s;
return *this;
}
// operators
inline thisclass& operator+=(const thisclass& v) {
for (size_t i = 0; i < N; i++) {
data_[i] += v.data_[i];
}
return *this;
}
inline thisclass& operator-=(const thisclass& v) {
for (size_t i = 0; i < N; i++) {
data_[i] -= v.data_[i];
}
return *this;
}
inline thisclass& operator*=(const thisclass& v) {
for (size_t i = 0; i < N; i++) {
data_[i] *= v.data_[i];
}
return *this;
}
inline thisclass& operator/=(const thisclass& v) {
for (size_t i = 0; i < N; i++) {
data_[i] /= v.data_[i];
}
return *this;
}
template <class T2> inline thisclass& operator*=(T2 s) {
for (size_t i = 0; i < N; i++) {
data_[i] *= T(s);
}
return *this;
}
template <class T2> inline thisclass& operator/=(T2 s) {
for (size_t i = 0; i < N; i++) {
data_[i] /= T(s);
}
return *this;
}
inline thisclass operator+ (const thisclass& v) const {
thisclass result(*this);
for (size_t i = 0; i < N; i++) {
result.data_[i] += v.data_[i];
}
return result;
}
inline thisclass operator- (const thisclass& v) const {
thisclass result(*this);
for (size_t i = 0; i < N; i++) {
result.data_[i] -= v.data_[i];
}
return result;
}
template <class T2> inline thisclass operator* (T2 s) const {
thisclass result(*this);
for (size_t i = 0; i < N; i++) {
result.data_[i] *= T(s);
}
return result;
}
template <class T2> inline thisclass operator/ (T2 s) const {
thisclass result(*this);
for (size_t i = 0; i < N; i++) {
result.data_[i] /= T(s);
}
return result;
}
inline thisclass operator- () const {
thisclass result;
for (size_t i = 0; i < N; i++) {
result.data_[i] = -data_[i];
}
return result;
}
private:
T data_[N];
};
template <size_t N, class T> inline T dot(const Vec<N, T>& v1, const Vec<N, T>& v2) {
T result = 0;
for (size_t i = 0; i < N; i++) {
result += v1[i] * v2[i];
}
return result;
}
template <size_t N, class T> inline Vec<N, T> operator-(const Vec<N, T>& v1) {
Vec<N, T> result;
for (size_t i = 0; i < N; i++) {
result[i] = -v1[i];
}
return result;
}
template <class T2, size_t N, class T> inline Vec<N, T> operator*(T2 s, const Vec<N, T>& v) {
Vec<N, T> result;
for (size_t i = 0; i < N; i++) {
result[i] = T(s)*v[i];
}
return result;
}
template <size_t N, class T> inline Vec<N, T> operator+(const Vec<N, T>& v1, const Vec<N, T>& v2) {
Vec<N, T> result;
for (size_t i = 0; i < N; i++) {
result[i] = v1[i] + v2[i];
}
return result;
}
template <size_t N, class T> inline Vec<N, T> operator-(const Vec<N, T>& v1, const Vec<N, T>& v2) {
Vec<N, T> result;
for (size_t i = 0; i < N; i++) {
result[i] = v1[i] - v2[i];
}
return result;
}
// Compatibility with GLSL
template <size_t N, class T> inline T length(const Vec<N, T>& v) { return v.length(); }
template <size_t N, class T> inline T norm(const Vec<N, T>& v) { return v.length(); }
template <size_t N, class T> inline T length2(const Vec<N, T>& v) { return v.length2(); }
template <size_t N, class T> inline T distance(const Vec<N, T>& v1, const Vec<N, T>& v2) { return length(v2 - v1); }
template <size_t N, class T> inline T distance2(const Vec<N, T>& v1, const Vec<N, T>& v2) { return v2.distance2(v1); }
template <size_t N, class T> inline Vec<N, T> normalize(const Vec<N, T>& v) {
T s = v.length();
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
return v * s;
}
// linear interpolation between x and y using a to weight between them.
// The return value is computed as (1 w) * v1 + w * v2.
template <size_t N, class T> inline Vec<N, T> mix(const Vec<N, T>& v1, const Vec<N, T>& v2, T w) {
return (T(1) - w) * v1 + w * v2;
}
//-------------------- vec2 -------------------------------------------------------------------
template <class T>
class Vec<2, T> {
public:
typedef Vec<2, T> thisclass;
Vec() : x(0), y(0) { }
Vec(T x_in, T y_in) : x(x_in), y(y_in) { }
Vec(const Vec<3, T>& v) : x(v.x), y(v.y) { } // very useful for inverse promoting from homogeneous coordinates
explicit Vec(const T& s) : x(s), y(s) { }
template<class T2> explicit Vec(const Vec<2, T2> & v)
: x(v.x), y(v.y) {}
template<class T2> explicit Vec(const T2* v)
: x(T(v[0])), y(T(v[1])) {}
inline T length2() const { return x*x + y*y; }
inline T length() const { return std::sqrt(x*x + y*y); }
inline T norm() const { return length(); }
inline T distance2(const thisclass& rhs) const {
T dx = rhs.x - x;
T dy = rhs.y - y;
return dx*dx + dy*dy;
}
inline thisclass& normalize() {
T s = length();
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
*this *= s;
return *this;
}
// operators
inline thisclass& operator+=(const thisclass& v) { x += v.x; y += v.y; return *this; }
inline thisclass& operator-=(const thisclass& v) { x -= v.x; y -= v.y; return *this; }
inline thisclass& operator*=(const thisclass& v) { x *= v.x; y *= v.y; return *this; }
inline thisclass& operator/=(const thisclass& v) { x /= v.x; y /= v.y; return *this; }
template <class T2> inline thisclass& operator*=(T2 s) { x *= T(s); y *= T(s); return *this; }
template <class T2> inline thisclass& operator/=(T2 s) { x /= T(s); y /= T(s); return *this; }
inline thisclass operator+ (const thisclass& v) const { return thisclass(x + v.x, y + v.y); }
inline thisclass operator- (const thisclass& v) const { return thisclass(x - v.x, y - v.y); }
template <class T2> inline thisclass operator* (T2 s) const { return thisclass(x*T(s), y*T(s)); }
template <class T2> inline thisclass operator/ (T2 s) const { return thisclass(x / T(s), y / T(s)); }
inline thisclass operator- () const { return thisclass(-x, -y); }
size_t dimension() const { return (size_t)2; }
size_t size() const { return dimension(); }
T* data() { return _array; }
const T* data() const { return _array; }
// Conversion operator returning the memory address of the data.
// Very convenient to pass the data pointer as a parameter to functions.
// e.g., glVertex2fv(pos);
operator const T*() const { return _array; }
operator T*() { return _array; }
inline T& operator[](int idx) {
assert(idx < 2);
return _array[idx];
}
inline const T& operator[](int idx) const {
assert(idx < 2);
return _array[idx];
}
//data intentionally left public to allow vec.x
union {
struct { T x, y; }; // standard names for components
struct { T u, v; }; // standard names for components
T _array[2]; // array access
};
};
template <class T> inline T dot(const Vec<2, T>& v1, const Vec<2, T>& v2) { return v1.x*v2.x + v1.y*v2.y; }
template <class T> inline T det(const Vec<2, T>& v1, const Vec<2, T>& v2) {
return v1.x*v2.y - v1.y*v2.x;
}
template <class T> inline Vec<2, T> operator-(const Vec<2, T>& v1) {
return Vec<2, T>(-v1.x, -v1.y);
}
template <class T2, class T> inline Vec<2, T> operator*(T2 s, const Vec<2, T>& v) {
return Vec<2, T>(T(s)*v.x, T(s)*v.y);
}
template <class T> inline Vec<2, T> operator+(const Vec<2, T>& v1, const Vec<2, T>& v2) {
return Vec<2, T>(v1.x + v2.x, v1.y + v2.y);
}
template <class T> inline Vec<2, T> operator-(const Vec<2, T>& v1, const Vec<2, T>& v2) {
return Vec<2, T>(v1.x - v2.x, v1.y - v2.y);
}
//---------------- vec3 ------------------------------------------------------------------------
template <class T>
class Vec<3, T> {
public:
typedef Vec<3, T> thisclass;
Vec() : x(0), y(0), z(0) {}
Vec(const Vec<2, T>& v, const T& s = 0) : x(v.x), y(v.y), z(s) {} // very useful for promoting to homogeneous coordinates
Vec(const Vec<4, T>& v) : x(v.x), y(v.y), z(v.z) {} // very useful for inverse promoting from homogeneous coordinates
Vec(T x_in, T y_in, T z_in) : x(x_in), y(y_in), z(z_in) {}
explicit Vec(const T& s) : x(s), y(s), z(s) { }
template<class T2> explicit Vec(const Vec<3, T2> & v) : x(v.x), y(v.y), z(v.z) {}
template<class T2> explicit Vec(const T2* v)
: x(T(v[0])), y(T(v[1])), z(T(v[2])) {}
inline T length2() const { return x*x + y*y + z*z; }
inline T length() const { return std::sqrt(x*x + y*y + z*z); }
inline T norm() const { return length(); }
inline T distance2(const thisclass& rhs) const {
T dx = rhs.x - x;
T dy = rhs.y - y;
T dz = rhs.z - z;
return dx*dx + dy*dy + dz*dz;
}
inline thisclass& normalize() {
T s = length();
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
*this *= s;
return *this;
}
// operators
inline thisclass& operator+=(const thisclass& v) { x += v.x; y += v.y; z += v.z; return *this; }
inline thisclass& operator-=(const thisclass& v) { x -= v.x; y -= v.y; z -= v.z; return *this; }
inline thisclass& operator*=(const thisclass& v) { x *= v.x; y *= v.y; z *= v.z; return *this; }
inline thisclass& operator/=(const thisclass& v) { x /= v.x; y /= v.y; z /= v.z; return *this; }
template <class T2> inline thisclass& operator*=(T2 s) { x *= T(s); y *= T(s); z *= T(s); return *this; }
template <class T2> inline thisclass& operator/=(T2 s) { x /= T(s); y /= T(s); z /= T(s); return *this; }
inline thisclass operator+ (const thisclass& v) const { return thisclass(x + v.x, y + v.y, z + v.z); }
inline thisclass operator- (const thisclass& v) const { return thisclass(x - v.x, y - v.y, z - v.z); }
template <class T2> inline thisclass operator* (T2 s) const { return thisclass(x*T(s), y*T(s), z*T(s)); }
template <class T2> inline thisclass operator/ (T2 s) const { return thisclass(x / T(s), y / T(s), z / T(s)); }
inline thisclass operator- () const { return thisclass(-x, -y, -z); }
size_t dimension() const { return (size_t)3; }
size_t size() const { return dimension(); }
T* data() { return _array; }
const T* data() const { return _array; }
// Conversion operator returning the memory address of the data.
// Very convenient to pass the data pointer as a parameter to functions.
// ------------
// vec3 pos, normal;
// glNormal3fv(normal);
// glVertex3fv(pos);
// ------------
operator const T*() const { return _array; }
operator T*() { return _array; }
inline T& operator[](int idx) {
assert(idx < 3);
return _array[idx];
}
inline const T& operator[](int idx) const {
assert(idx < 3);
return _array[idx];
}
//data intentionally left public to allow vec.x
union {
struct { T x, y, z; }; // standard names for components
struct { T u, v, w; }; // standard names for components
struct { T r, g, b; }; // standard names for components
T _array[3]; // array access
};
};
template <class T> inline T dot(const Vec<3, T>& v1, const Vec<3, T>& v2) {
return v1.x*v2.x + v1.y*v2.y + v1.z*v2.z;
}
template <class T> inline Vec<3, T> cross(const Vec<3, T>& v1, const Vec<3, T>& v2) {
return Vec<3, T>(
v1.y*v2.z - v1.z*v2.y,
v1.z*v2.x - v1.x*v2.z,
v1.x*v2.y - v1.y*v2.x
);
}
template <class T> inline Vec<3, T> operator-(const Vec<3, T>& v1) { return Vec<3, T>(-v1.x, -v1.y, -v1.z); }
template <class T2, class T> inline Vec<3, T> operator*(T2 s, const Vec<3, T>& v) {
return Vec<3, T>(T(s)*v.x, T(s)*v.y, T(s)*v.z);
}
template <class T> inline Vec<3, T> operator+(const Vec<3, T>& v1, const Vec<3, T>& v2) {
return Vec<3, T>(v1.x + v2.x, v1.y + v2.y, v1.z + v2.z);
}
template <class T> inline Vec<3, T> operator-(const Vec<3, T>& v1, const Vec<3, T>& v2) {
return Vec<3, T>(v1.x - v2.x, v1.y - v2.y, v1.z - v2.z);
}
template <class T> inline Vec<3, T> orthogonal(const Vec<3, T>& v) {
T absx = ::fabs(v.x);
T absy = ::fabs(v.y);
T absz = ::fabs(v.z);
// Find smallest component. Keep equal case for null values.
if ((absy >= absx) && (absz >= absx))
return Vec<3, T>(0.0, -v.z, v.y);
else
if ((absx >= absy) && (absz >= absy))
return Vec<3, T>(-v.z, 0.0f, v.x);
else
return Vec<3, T>(-v.y, v.x, 0.0f);
}
// ----------------- vec4 ----------------------------------------------------------------------------------
template <class T>
class Vec<4, T> {
public:
typedef Vec<4, T> thisclass;
Vec() : x(0), y(0), z(0), w(0) {}
Vec(const Vec<3, T>& v, const T& s = 0) : x(v.x), y(v.y), z(v.z), w(s) {} // very useful for promoting to homogeneous coordinates
Vec(T x_in, T y_in, T z_in, T w_in) : x(x_in), y(y_in), z(z_in), w(w_in) {}
explicit Vec(const T& s) : x(s), y(s), z(s), w(s) { }
template<class T2> explicit Vec(const Vec<4, T2> & v)
: x(v.x), y(v.y), z(v.z), w(v.w) {}
template<class T2> explicit Vec(const T2* v)
: x(v[0]), y(v[1]), z(v[2]), w(v[3]) {}
inline T length2() const { return x*x + y*y + z*z + w*w; }
inline T length() const { return std::sqrt(x*x + y*y + z*z + w*w); }
inline T norm() const { return length(); }
inline T distance2(const thisclass& rhs) const {
T dx = rhs.x - x;
T dy = rhs.y - y;
T dz = rhs.z - z;
T dw = rhs.w - w;
return dx*dx + dy*dy + dz*dz + dw*dw;
}
inline thisclass& normalize() {
T s = length();
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
*this *= s;
return *this;
}
size_t dimension() const { return (size_t)4; }
size_t size() const { return dimension(); }
// operators
inline thisclass& operator+=(const thisclass& v) { x += v.x; y += v.y; z += v.z; w += v.w; return *this; }
inline thisclass& operator-=(const thisclass& v) { x -= v.x; y -= v.y; z -= v.z; w -= v.w; return *this; }
inline thisclass& operator*=(const thisclass& v) { x *= v.x; y *= v.y; z *= v.z; w *= v.w; return *this; }
inline thisclass& operator/=(const thisclass& v) { x /= v.x; y /= v.y; z /= v.z; w /= v.w; return *this; }
template <class T2> inline thisclass& operator*=(T2 s) {
x *= T(s); y *= T(s); z *= T(s); w *= T(s); return *this;
}
template <class T2> inline thisclass& operator/=(T2 s) {
x /= T(s); y /= T(s); z /= T(s); w /= T(s); return *this;
}
inline thisclass operator+ (const thisclass& v) const { return thisclass(x + v.x, y + v.y, z + v.z, w + v.w); }
inline thisclass operator- (const thisclass& v) const { return thisclass(x - v.x, y - v.y, z - v.z, w - v.w); }
template <class T2> inline thisclass operator* (T2 s) const { return thisclass(x*T(s), y*T(s), z*T(s), w*T(s)); }
template <class T2> inline thisclass operator/ (T2 s) const { return thisclass(x / T(s), y / T(s), z / T(s), w / T(s)); }
inline thisclass operator- () const { return thisclass(-x, -y, -z, -w); }
T* data() { return _array; }
const T* data() const { return _array; }
// Conversion operator returning the memory address of the data.
// Very convenient to pass the data pointer as a parameter to functions.
// e.g., glColor4fv(c);
operator const T*() const { return _array; }
operator T*() { return _array; }
inline T& operator[](int idx) {
assert(idx < 4);
return _array[idx];
}
inline const T& operator[](int idx) const {
assert(idx < 4);
return _array[idx];
}
//data intentionally left public to allow vec.x
union {
struct { T x, y, z, w; }; // standard names for components
struct { T r, g, b, a; }; // standard names for components
T _array[4]; // array access
};
};
template <class T> inline T dot(const Vec<4, T>& v1, const Vec<4, T>& v2) {
return v1.x*v2.x + v1.y*v2.y + v1.z*v2.z + v1.w*v2.w;
}
template <class T> inline Vec<4, T> operator-(const Vec<4, T>& v1) { return Vec<4, T>(-v1.x, -v1.y, -v1.z, -v1.w); }
template <class T2, class T> inline Vec<4, T> operator*(T2 s, const Vec<4, T>& v) {
return Vec<4, T>(T(s)*v.x, T(s)*v.y, T(s)*v.z, T(s)*v.w);
}
template <class T> inline Vec<4, T> operator+(const Vec<4, T>& v1, const Vec<4, T>& v2) {
return Vec<4, T>(v1.x + v2.x, v1.y + v2.y, v1.z + v2.z, v1.w + v2.w);
}
template <class T> inline Vec<4, T> operator-(const Vec<4, T>& v1, const Vec<4, T>& v2) {
return Vec<4, T>(v1.x - v2.x, v1.y - v2.y, v1.z - v2.z, v1.w - v2.w);
}
template <size_t N, class T>
inline bool has_nan(const Vec<N, T> &v) {
for (std::size_t i = 0; i < N; ++i) {
if (std::isnan(v[i]) || std::isinf(v[i]))
return true;
}
return false;
}
//------------------------------- IO (input/output) ----------------------------
template <size_t N, class T> inline std::ostream& operator<<(std::ostream& out, const Vec<N, T>& v) {
for (size_t i = 0; i < N; i++) {
out << v[i] << " ";
}
return out;
}
template <size_t N, class T> inline std::istream& operator>>(std::istream& in, Vec<N, T>& v) {
for (size_t i = 0; i < N; i++) {
in >> v[i];
}
return in;
}
template <class T> inline std::ostream& operator<<(std::ostream& out, const Vec<2, T>& v) {
return out << v.x << " " << v.y;
}
template <class T> inline std::istream& operator>>(std::istream& in, Vec<2, T>& v) {
return in >> v.x >> v.y;
}
template <class T> inline std::ostream& operator<<(std::ostream& out, const Vec<3, T>& v) {
return out << v.x << " " << v.y << " " << v.z;
}
template <class T> inline std::istream& operator>>(std::istream& in, Vec<3, T>& v) {
return in >> v.x >> v.y >> v.z;
}
template <class T> inline std::ostream& operator<<(std::ostream& out, const Vec<4, T>& v) {
return out << v.x << " " << v.y << " " << v.z << " " << v.w;
}
template <class T> inline std::istream& operator>>(std::istream& in, Vec<4, T>& v) {
return in >> v.x >> v.y >> v.z >> v.w;
}
#else
template <size_t DIM, typename T> struct Vec {
Vec() { for (size_t i=DIM; i--; data_[i] = T()); }
T& operator[](const size_t i) { assert(i<DIM); return data_[i]; }
const T& operator[](const size_t i) const { assert(i<DIM); return data_[i]; }
private:
T data_[DIM];
};
typedef Vec<2, float> vec2;
typedef Vec<3, float> vec3;
typedef Vec<3, int > vec3i;
typedef Vec<4, float> vec4;
template <typename T> struct Vec<2,T> {
Vec() : x(T()), y(T()) {}
Vec(T X, T Y) : x(X), y(Y) {}
template <class U> Vec<2,T>(const Vec<2,U> &v);
T& operator[](const size_t i) { assert(i<2); return i<=0 ? x : y; }
const T& operator[](const size_t i) const { assert(i<2); return i<=0 ? x : y; }
T x,y;
};
template <typename T> struct Vec<3,T> {
Vec() : x(T()), y(T()), z(T()) {}
Vec(T X, T Y, T Z) : x(X), y(Y), z(Z) {}
T& operator[](const size_t i) { assert(i<3); return i<=0 ? x : (1==i ? y : z); }
const T& operator[](const size_t i) const { assert(i<3); return i<=0 ? x : (1==i ? y : z); }
float norm() { return std::sqrt(x*x+y*y+z*z); }
Vec<3,T> & normalize(T l=1) { *this = (*this)*(l/norm()); return *this; }
T x,y,z;
};
template <typename T> struct Vec<4,T> {
Vec() : x(T()), y(T()), z(T()), w(T()) {}
Vec(T X, T Y, T Z, T W) : x(X), y(Y), z(Z), w(W) {}
T& operator[](const size_t i) { assert(i<4); return i<=0 ? x : (1==i ? y : (2==i ? z : w)); }
const T& operator[](const size_t i) const { assert(i<4); return i<=0 ? x : (1==i ? y : (2==i ? z : w)); }
T x,y,z,w;
};
template<size_t DIM,typename T> T operator*(const Vec<DIM,T>& lhs, const Vec<DIM,T>& rhs) {
T ret = T();
for (size_t i=DIM; i--; ret+=lhs[i]*rhs[i]);
return ret;
}
template<size_t DIM,typename T>Vec<DIM,T> operator+(Vec<DIM,T> lhs, const Vec<DIM,T>& rhs) {
for (size_t i=DIM; i--; lhs[i]+=rhs[i]);
return lhs;
}
template<size_t DIM,typename T>Vec<DIM,T> operator-(Vec<DIM,T> lhs, const Vec<DIM,T>& rhs) {
for (size_t i=DIM; i--; lhs[i]-=rhs[i]);
return lhs;
}
template<size_t DIM,typename T,typename U> Vec<DIM,T> operator*(const Vec<DIM,T> &lhs, const U& rhs) {
Vec<DIM,T> ret;
for (size_t i=DIM; i--; ret[i]=lhs[i]*rhs);
return ret;
}
template<size_t DIM,typename T> Vec<DIM,T> operator-(const Vec<DIM,T> &lhs) {
return lhs*T(-1);
}
template<size_t DIM,typename T> T dot(const Vec<DIM,T>& lhs, const Vec<DIM,T>& rhs) {
T ret = T();
for (size_t i=DIM; i--; ret+=lhs[i]*rhs[i]);
return ret;
}
template <typename T> Vec<3,T> cross(Vec<3,T> v1, Vec<3,T> v2) {
return Vec<3,T>(v1.y*v2.z - v1.z*v2.y, v1.z*v2.x - v1.x*v2.z, v1.x*v2.y - v1.y*v2.x);
}
template <size_t DIM, typename T> std::ostream& operator<<(std::ostream& out, const Vec<DIM,T>& v) {
for(unsigned int i=0; i<DIM; i++) out << v[i] << " " ;
return out ;
}
#endif
}
#endif // EASY3D_VEC_H

View File

@ -1,37 +0,0 @@
cmake_minimum_required(VERSION 3.1)
get_filename_component(MODULE_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
set(PROJECT_NAME easy3d_${MODULE_NAME})
project(${PROJECT_NAME})
set(${PROJECT_NAME}_HEADERS
graph_io.h
ply_reader_writer.h
point_cloud_io.h
surface_mesh_io.h
)
set(${PROJECT_NAME}_SOURCES
graph_io.cpp
graph_io_ply.cpp
ply_reader_writer.cpp
point_cloud_io.cpp
point_cloud_io_xyz.cpp
surface_mesh_io.cpp
surface_mesh_io_obj.cpp
)
add_library(${PROJECT_NAME} STATIC ${${PROJECT_NAME}_SOURCES} ${${PROJECT_NAME}_HEADERS} )
set_target_properties(${PROJECT_NAME} PROPERTIES FOLDER "3rd_party/easy3d")
target_include_directories(${PROJECT_NAME} PRIVATE ${ADTREE_easy3d_INCLUDE_DIR})
target_link_libraries(${PROJECT_NAME} easy3d_core 3rd_rply easy3d_util)
if (MSVC)
target_compile_definitions(${PROJECT_NAME} PRIVATE _CRT_SECURE_NO_DEPRECATE)
endif()

View File

@ -1,124 +0,0 @@
/*
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
* https://3d.bk.tudelft.nl/liangliang/
*
* This file is part of Easy3D. If it is useful in your research/work,
* I would be grateful if you show your appreciation by citing it:
* ------------------------------------------------------------------
* Liangliang Nan.
* Easy3D: a lightweight, easy-to-use, and efficient C++
* library for processing and rendering 3D data. 2018.
* ------------------------------------------------------------------
*
* Easy3D is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License Version 3
* as published by the Free Software Foundation.
*
* Easy3D is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include <easy3d/fileio/graph_io.h>
#include <clocale>
#include <easy3d/core/graph.h>
#include <easy3d/util/file_system.h>
#include <easy3d/util/stop_watch.h>
namespace easy3d {
Graph* GraphIO::load(const std::string& file_name)
{
std::setlocale(LC_NUMERIC, "C");
Graph* graph = new Graph;
graph->set_name(file_name);
StopWatch w;
bool success = false;
const std::string& ext = file_system::extension(file_name, true);
if (ext == "ply")
success = io::load_ply(file_name, graph);
else if (ext.empty()){
std::cerr << "unknown file format: no extention" << ext << std::endl;
success = false;
}
else {
std::cerr << "unknown file format: " << ext << ". Only PLY format is supported for Graph" << ext << std::endl;
return nullptr;
}
if (!success || graph->n_vertices() == 0) {
delete graph;
return nullptr;
}
#ifndef NDEBUG
std::cout << "vertex properties on graph " << file_system::simple_name(file_name) << std::endl;
const auto& vnames = graph->vertex_properties();
for (const auto& n : vnames)
std::cout << "\t" << n << std::endl;
std::cout << "edge properties on graph " << file_system::simple_name(file_name) << std::endl;
const auto& enames = graph->edge_properties();
for (const auto& n : enames)
std::cout << "\t" << n << std::endl;
#endif
if (success)
std::cout << "load model done. time: " << w.time_string() << std::endl;
else
std::cout << "load model failed" << std::endl;
return graph;
}
bool GraphIO::save(const std::string& file_name, const Graph* graph)
{
if (!graph || graph->vertices_size() == 0) {
std::cerr << "graph is null" << std::endl;
return false;
}
StopWatch w;
bool success = false;
std::string final_name = file_name;
const std::string& ext = file_system::extension(file_name, true);
if (ext == "ply" || ext.empty()) {
if (ext.empty()) {
std::cerr << "No extention specified. Default to ply" << ext << std::endl;
final_name = final_name + ".ply";
}
success = io::save_ply(final_name, graph, true);
}
else {
std::cerr << "unknown file format: " << ext << ". Only PLY format is supported for Graph" << ext << std::endl;
success = false;
}
if (success) {
std::cout << "save model done. time: " << w.time_string() << std::endl;
return true;
}
else {
std::cout << "save model failed" << std::endl;
return false;
}
}
} // namespace easy3d

Some files were not shown because too many files have changed in this diff Show More