Index: /issm/trunk-jpl/externalpackages/autotools/install-debian-linux.sh =================================================================== --- /issm/trunk-jpl/externalpackages/autotools/install-debian-linux.sh (revision 24648) +++ /issm/trunk-jpl/externalpackages/autotools/install-debian-linux.sh (revision 24649) @@ -2,22 +2,25 @@ set -eu -#Version numbers -M4_VER="1.4.18" + +## Constants +# AUTOCONF_VER="2.69" AUTOMAKE_VER="1.16.1" LIBTOOL_VER="2.4.2" +M4_VER="1.4.18" -# Clean up existing directories +## Environment +# +export PATH="${ISSM_DIR}/externalpackages/autotools/install/bin:$PATH" + +# Cleanup rm -rf install src - -# Set up for installation mkdir install -export PATH="$ISSM_DIR/externalpackages/autotools/install/bin:$PATH" # Install m4 echo " === INSTALLING M4 ==" -$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/m4-$M4_VER.tar.gz" "m4-$M4_VER.tar.gz" -tar -zxvf m4-$M4_VER.tar.gz -mv m4-$M4_VER src +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/m4-${M4_VER}.tar.gz" "m4-${M4_VER}.tar.gz" +tar -zxvf m4-${M4_VER}.tar.gz +mv m4-${M4_VER} src cd src @@ -29,29 +32,29 @@ echo "#define _IO_IN_BACKUP 0x100" >> lib/stdio-impl.h -./configure --prefix="$ISSM_DIR/externalpackages/autotools/install" +./configure --prefix="${ISSM_DIR}/externalpackages/autotools/install" make make install cd .. -# Install autoconf +# Install Autoconf echo " === INSTALLING AUTOCONF ==" rm -rf src -$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/autoconf-$AUTOCONF_VER.tar.gz" "autoconf-$AUTOCONF_VER.tar.gz" -tar -zxvf autoconf-$AUTOCONF_VER.tar.gz -mv autoconf-$AUTOCONF_VER src +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/autoconf-${AUTOCONF_VER}.tar.gz" "autoconf-${AUTOCONF_VER}.tar.gz" +tar -zxvf autoconf-${AUTOCONF_VER}.tar.gz +mv autoconf-${AUTOCONF_VER} src cd src -./configure --prefix="$ISSM_DIR/externalpackages/autotools/install" +./configure --prefix="${ISSM_DIR}/externalpackages/autotools/install" make make install cd .. -#install automake +# Install Automake echo " === INSTALLING AUTOMAKE ==" rm -rf src -$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/automake-$AUTOMAKE_VER.tar.gz" "automake-$AUTOMAKE_VER.tar.gz" -tar -zxvf automake-$AUTOMAKE_VER.tar.gz -mv automake-$AUTOMAKE_VER src +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/automake-${AUTOMAKE_VER}.tar.gz" "automake-${AUTOMAKE_VER}.tar.gz" +tar -zxvf automake-${AUTOMAKE_VER}.tar.gz +mv automake-${AUTOMAKE_VER} src cd src -./configure --prefix="$ISSM_DIR/externalpackages/autotools/install" +./configure --prefix="${ISSM_DIR}/externalpackages/autotools/install" make make install @@ -61,10 +64,10 @@ echo " === INSTALLING LIBTOOL ==" rm -rf src -$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/libtool-$LIBTOOL_VER.tar.gz" "libtool-$LIBTOOL_VER.tar.gz" -tar -zxvf libtool-$LIBTOOL_VER.tar.gz -rm libtool-$LIBTOOL_VER.tar.gz -mv libtool-$LIBTOOL_VER src +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/libtool-${LIBTOOL_VER}.tar.gz" "libtool-${LIBTOOL_VER}.tar.gz" +tar -zxvf libtool-${LIBTOOL_VER}.tar.gz +rm libtool-${LIBTOOL_VER}.tar.gz +mv libtool-${LIBTOOL_VER} src cd src -./configure --prefix="$ISSM_DIR/externalpackages/autotools/install" +./configure --prefix="${ISSM_DIR}/externalpackages/autotools/install" make make install Index: /issm/trunk-jpl/externalpackages/autotools/install.sh =================================================================== --- /issm/trunk-jpl/externalpackages/autotools/install.sh (revision 24648) +++ /issm/trunk-jpl/externalpackages/autotools/install.sh (revision 24649) @@ -2,61 +2,65 @@ set -eu -#Version numbers -M4_VER="1.4.18" + +## Constants +# AUTOCONF_VER="2.69" AUTOMAKE_VER="1.16.1" LIBTOOL_VER="2.4.2" +M4_VER="1.4.18" -# Clean up existing directories +## Environment +# +export PATH="${ISSM_DIR}/externalpackages/autotools/install/bin:$PATH" + +# Cleanup rm -rf install src - -# Set up for installation mkdir install -export PATH="$ISSM_DIR/externalpackages/autotools/install/bin:$PATH" # Install m4 echo " === INSTALLING M4 ==" -$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/m4-$M4_VER.tar.gz" "m4-$M4_VER.tar.gz" -tar -zxvf m4-$M4_VER.tar.gz -mv m4-$M4_VER src +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/m4-${M4_VER}.tar.gz" "m4-${M4_VER}.tar.gz" +tar -zxvf m4-${M4_VER}.tar.gz +mv m4-${M4_VER} src cd src -./configure --prefix="$ISSM_DIR/externalpackages/autotools/install" + +./configure --prefix="${ISSM_DIR}/externalpackages/autotools/install" make make install cd .. -#install autoconf +# Install Autoconf echo " === INSTALLING AUTOCONF ==" rm -rf src -$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/autoconf-$AUTOCONF_VER.tar.gz" "autoconf-$AUTOCONF_VER.tar.gz" -tar -zxvf autoconf-$AUTOCONF_VER.tar.gz -mv autoconf-$AUTOCONF_VER src +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/autoconf-${AUTOCONF_VER}.tar.gz" "autoconf-${AUTOCONF_VER}.tar.gz" +tar -zxvf autoconf-${AUTOCONF_VER}.tar.gz +mv autoconf-${AUTOCONF_VER} src cd src -./configure --prefix="$ISSM_DIR/externalpackages/autotools/install" +./configure --prefix="${ISSM_DIR}/externalpackages/autotools/install" make make install cd .. -#install automake +# Install Automake echo " === INSTALLING AUTOMAKE ==" rm -rf src -$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/automake-$AUTOMAKE_VER.tar.gz" "automake-$AUTOMAKE_VER.tar.gz" -tar -zxvf automake-$AUTOMAKE_VER.tar.gz -mv automake-$AUTOMAKE_VER src +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/automake-${AUTOMAKE_VER}.tar.gz" "automake-${AUTOMAKE_VER}.tar.gz" +tar -zxvf automake-${AUTOMAKE_VER}.tar.gz +mv automake-${AUTOMAKE_VER} src cd src -./configure --prefix="$ISSM_DIR/externalpackages/autotools/install" +./configure --prefix="${ISSM_DIR}/externalpackages/autotools/install" make make install cd .. -#install libtool +# Install libtool echo " === INSTALLING LIBTOOL ==" rm -rf src -$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/libtool-$LIBTOOL_VER.tar.gz" "libtool-$LIBTOOL_VER.tar.gz" -tar -zxvf libtool-$LIBTOOL_VER.tar.gz -rm libtool-$LIBTOOL_VER.tar.gz -mv libtool-$LIBTOOL_VER src +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/libtool-${LIBTOOL_VER}.tar.gz" "libtool-${LIBTOOL_VER}.tar.gz" +tar -zxvf libtool-${LIBTOOL_VER}.tar.gz +rm libtool-${LIBTOOL_VER}.tar.gz +mv libtool-${LIBTOOL_VER} src cd src -./configure --prefix="$ISSM_DIR/externalpackages/autotools/install" +./configure --prefix="${ISSM_DIR}/externalpackages/autotools/install" make make install Index: /issm/trunk-jpl/externalpackages/boost/configs/1.55/boost/multi_index/ordered_index.hpp =================================================================== --- /issm/trunk-jpl/externalpackages/boost/configs/1.55/boost/multi_index/ordered_index.hpp (revision 24649) +++ /issm/trunk-jpl/externalpackages/boost/configs/1.55/boost/multi_index/ordered_index.hpp (revision 24649) @@ -0,0 +1,1529 @@ +/* Copyright 2003-2013 Joaquin M Lopez Munoz. + * Distributed under the Boost Software License, Version 1.0. + * (See accompanying file LICENSE_1_0.txt or copy at + * http://www.boost.org/LICENSE_1_0.txt) + * + * See http://www.boost.org/libs/multi_index for library home page. + * + * The internal implementation of red-black trees is based on that of SGI STL + * stl_tree.h file: + * + * Copyright (c) 1996,1997 + * Silicon Graphics Computer Systems, Inc. + * + * Permission to use, copy, modify, distribute and sell this software + * and its documentation for any purpose is hereby granted without fee, + * provided that the above copyright notice appear in all copies and + * that both that copyright notice and this permission notice appear + * in supporting documentation. Silicon Graphics makes no + * representations about the suitability of this software for any + * purpose. It is provided "as is" without express or implied warranty. + * + * + * Copyright (c) 1994 + * Hewlett-Packard Company + * + * Permission to use, copy, modify, distribute and sell this software + * and its documentation for any purpose is hereby granted without fee, + * provided that the above copyright notice appear in all copies and + * that both that copyright notice and this permission notice appear + * in supporting documentation. Hewlett-Packard Company makes no + * representations about the suitability of this software for any + * purpose. It is provided "as is" without express or implied warranty. + * + */ + +#ifndef BOOST_MULTI_INDEX_ORDERED_INDEX_HPP +#define BOOST_MULTI_INDEX_ORDERED_INDEX_HPP + +#if defined(_MSC_VER)&&(_MSC_VER>=1200) +#pragma once +#endif + +#include /* keep it first to prevent nasty warns in MSVC */ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#if !defined(BOOST_NO_CXX11_HDR_INITIALIZER_LIST) +#include +#endif + +#if !defined(BOOST_MULTI_INDEX_DISABLE_SERIALIZATION) +#include +#include +#include +#include +#endif + +#if defined(BOOST_MULTI_INDEX_ENABLE_INVARIANT_CHECKING) +#define BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT_OF(x) \ + detail::scope_guard BOOST_JOIN(check_invariant_,__LINE__)= \ + detail::make_obj_guard(x,&ordered_index::check_invariant_); \ + BOOST_JOIN(check_invariant_,__LINE__).touch(); +#define BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT \ + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT_OF(*this) +#else +#define BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT_OF(x) +#define BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT +#endif + +namespace boost{ + +namespace multi_index{ + +namespace detail{ + +/* ordered_index adds a layer of ordered indexing to a given Super */ + +/* Most of the implementation of unique and non-unique indices is + * shared. We tell from one another on instantiation time by using + * these tags. + */ + +struct ordered_unique_tag{}; +struct ordered_non_unique_tag{}; + +template< + typename KeyFromValue,typename Compare, + typename SuperMeta,typename TagList,typename Category +> +class ordered_index: + BOOST_MULTI_INDEX_PROTECTED_IF_MEMBER_TEMPLATE_FRIENDS SuperMeta::type + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) +#if BOOST_WORKAROUND(BOOST_MSVC,<1300) + ,public safe_ctr_proxy_impl< + bidir_node_iterator< + ordered_index_node >, + ordered_index > +#else + ,public safe_mode::safe_container< + ordered_index > +#endif +#endif + +{ +#if defined(BOOST_MULTI_INDEX_ENABLE_INVARIANT_CHECKING)&&\ + BOOST_WORKAROUND(__MWERKS__,<=0x3003) +/* The "ISO C++ Template Parser" option in CW8.3 has a problem with the + * lifetime of const references bound to temporaries --precisely what + * scopeguards are. + */ + +#pragma parse_mfunc_templ off +#endif + + typedef typename SuperMeta::type super; + +protected: + typedef ordered_index_node< + typename super::node_type> node_type; + +private: + typedef typename node_type::impl_type node_impl_type; + typedef typename node_impl_type::pointer node_impl_pointer; + +public: + /* types */ + + typedef typename KeyFromValue::result_type key_type; + typedef typename node_type::value_type value_type; + typedef KeyFromValue key_from_value; + typedef Compare key_compare; + typedef value_comparison< + value_type,KeyFromValue,Compare> value_compare; + typedef tuple ctor_args; + typedef typename super::final_allocator_type allocator_type; + typedef typename allocator_type::reference reference; + typedef typename allocator_type::const_reference const_reference; + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) +#if BOOST_WORKAROUND(BOOST_MSVC,<1300) + typedef safe_mode::safe_iterator< + bidir_node_iterator, + safe_ctr_proxy< + bidir_node_iterator > > iterator; +#else + typedef safe_mode::safe_iterator< + bidir_node_iterator, + ordered_index> iterator; +#endif +#else + typedef bidir_node_iterator iterator; +#endif + + typedef iterator const_iterator; + + typedef std::size_t size_type; + typedef std::ptrdiff_t difference_type; + typedef typename allocator_type::pointer pointer; + typedef typename allocator_type::const_pointer const_pointer; + typedef typename + boost::reverse_iterator reverse_iterator; + typedef typename + boost::reverse_iterator const_reverse_iterator; + typedef TagList tag_list; + +protected: + typedef typename super::final_node_type final_node_type; + typedef tuples::cons< + ctor_args, + typename super::ctor_args_list> ctor_args_list; + typedef typename mpl::push_front< + typename super::index_type_list, + ordered_index>::type index_type_list; + typedef typename mpl::push_front< + typename super::iterator_type_list, + iterator>::type iterator_type_list; + typedef typename mpl::push_front< + typename super::const_iterator_type_list, + const_iterator>::type const_iterator_type_list; + typedef typename super::copy_map_type copy_map_type; + +#if !defined(BOOST_MULTI_INDEX_DISABLE_SERIALIZATION) + typedef typename super::index_saver_type index_saver_type; + typedef typename super::index_loader_type index_loader_type; +#endif + +private: +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) +#if BOOST_WORKAROUND(BOOST_MSVC,<1300) + typedef safe_ctr_proxy_impl< + bidir_node_iterator, + ordered_index> safe_super; +#else + typedef safe_mode::safe_container safe_super; +#endif +#endif + + typedef typename call_traits< + value_type>::param_type value_param_type; + typedef typename call_traits< + key_type>::param_type key_param_type; + + /* Needed to avoid commas in BOOST_MULTI_INDEX_OVERLOADS_TO_VARTEMPL + * expansion. + */ + + typedef std::pair emplace_return_type; + +public: + + /* construct/copy/destroy + * Default and copy ctors are in the protected section as indices are + * not supposed to be created on their own. No range ctor either. + */ + + ordered_index& operator=( + const ordered_index& x) + { + this->final()=x.final(); + return *this; + } + +#if !defined(BOOST_NO_CXX11_HDR_INITIALIZER_LIST) + ordered_index& operator=( + std::initializer_list list) + { + this->final()=list; + return *this; + } +#endif + + allocator_type get_allocator()const + { + return this->final().get_allocator(); + } + + /* iterators */ + + iterator begin(){return make_iterator(leftmost());} + const_iterator begin()const{return make_iterator(leftmost());} + iterator end(){return make_iterator(header());} + const_iterator end()const{return make_iterator(header());} + reverse_iterator rbegin(){return boost::make_reverse_iterator(end());} + const_reverse_iterator rbegin()const{return make_reverse_iterator(end());} + reverse_iterator rend(){return make_reverse_iterator(begin());} + const_reverse_iterator rend()const{return make_reverse_iterator(begin());} + const_iterator cbegin()const{return begin();} + const_iterator cend()const{return end();} + const_reverse_iterator crbegin()const{return rbegin();} + const_reverse_iterator crend()const{return rend();} + + iterator iterator_to(const value_type& x) + { + return make_iterator(node_from_value(&x)); + } + + const_iterator iterator_to(const value_type& x)const + { + return make_iterator(node_from_value(&x)); + } + + /* capacity */ + + bool empty()const{return this->final_empty_();} + size_type size()const{return this->final_size_();} + size_type max_size()const{return this->final_max_size_();} + + /* modifiers */ + + BOOST_MULTI_INDEX_OVERLOADS_TO_VARTEMPL( + emplace_return_type,emplace,emplace_impl) + + BOOST_MULTI_INDEX_OVERLOADS_TO_VARTEMPL_EXTRA_ARG( + iterator,emplace_hint,emplace_hint_impl,iterator,position) + + std::pair insert(const value_type& x) + { + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + std::pair p=this->final_insert_(x); + return std::pair(make_iterator(p.first),p.second); + } + + std::pair insert(BOOST_RV_REF(value_type) x) + { + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + std::pair p=this->final_insert_rv_(x); + return std::pair(make_iterator(p.first),p.second); + } + + iterator insert(iterator position,const value_type& x) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + std::pair p=this->final_insert_( + x,static_cast(position.get_node())); + return make_iterator(p.first); + } + + iterator insert(iterator position,BOOST_RV_REF(value_type) x) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + std::pair p=this->final_insert_rv_( + x,static_cast(position.get_node())); + return make_iterator(p.first); + } + + template + void insert(InputIterator first,InputIterator last) + { + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + node_type* hint=header(); /* end() */ + for(;first!=last;++first){ + hint=this->final_insert_ref_( + *first,static_cast(hint)).first; + node_type::increment(hint); + } + } + +#if !defined(BOOST_NO_CXX11_HDR_INITIALIZER_LIST) + void insert(std::initializer_list list) + { + insert(list.begin(),list.end()); + } +#endif + + iterator erase(iterator position) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_DEREFERENCEABLE_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + this->final_erase_(static_cast(position++.get_node())); + return position; + } + + size_type erase(key_param_type x) + { + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + std::pair p=equal_range(x); + size_type s=0; + while(p.first!=p.second){ + p.first=erase(p.first); + ++s; + } + return s; + } + + iterator erase(iterator first,iterator last) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(first); + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(last); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(first,*this); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(last,*this); + BOOST_MULTI_INDEX_CHECK_VALID_RANGE(first,last); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + while(first!=last){ + first=erase(first); + } + return first; + } + + bool replace(iterator position,const value_type& x) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_DEREFERENCEABLE_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + return this->final_replace_( + x,static_cast(position.get_node())); + } + + bool replace(iterator position,BOOST_RV_REF(value_type) x) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_DEREFERENCEABLE_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + return this->final_replace_rv_( + x,static_cast(position.get_node())); + } + + template + bool modify(iterator position,Modifier mod) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_DEREFERENCEABLE_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + /* MSVC++ 6.0 optimizer on safe mode code chokes if this + * this is not added. Left it for all compilers as it does no + * harm. + */ + + position.detach(); +#endif + + return this->final_modify_( + mod,static_cast(position.get_node())); + } + + template + bool modify(iterator position,Modifier mod,Rollback back) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_DEREFERENCEABLE_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + /* MSVC++ 6.0 optimizer on safe mode code chokes if this + * this is not added. Left it for all compilers as it does no + * harm. + */ + + position.detach(); +#endif + + return this->final_modify_( + mod,back,static_cast(position.get_node())); + } + + template + bool modify_key(iterator position,Modifier mod) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_DEREFERENCEABLE_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + return modify( + position,modify_key_adaptor(mod,key)); + } + + template + bool modify_key(iterator position,Modifier mod,Rollback back) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_DEREFERENCEABLE_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + return modify( + position, + modify_key_adaptor(mod,key), + modify_key_adaptor(back,key)); + } + + void swap(ordered_index& x) + { + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT_OF(x); + this->final_swap_(x.final()); + } + + void clear() + { + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + this->final_clear_(); + } + + /* observers */ + + key_from_value key_extractor()const{return key;} + key_compare key_comp()const{return comp_;} + value_compare value_comp()const{return value_compare(key,comp_);} + + /* set operations */ + + /* Internally, these ops rely on const_iterator being the same + * type as iterator. + */ + + template + iterator find(const CompatibleKey& x)const + { + return make_iterator(ordered_index_find(root(),header(),key,x,comp_)); + } + + template + iterator find( + const CompatibleKey& x,const CompatibleCompare& comp)const + { + return make_iterator(ordered_index_find(root(),header(),key,x,comp)); + } + + template + size_type count(const CompatibleKey& x)const + { + return count(x,comp_); + } + + template + size_type count(const CompatibleKey& x,const CompatibleCompare& comp)const + { + std::pair p=equal_range(x,comp); + size_type n=std::distance(p.first,p.second); + return n; + } + + template + iterator lower_bound(const CompatibleKey& x)const + { + return make_iterator( + ordered_index_lower_bound(root(),header(),key,x,comp_)); + } + + template + iterator lower_bound( + const CompatibleKey& x,const CompatibleCompare& comp)const + { + return make_iterator( + ordered_index_lower_bound(root(),header(),key,x,comp)); + } + + template + iterator upper_bound(const CompatibleKey& x)const + { + return make_iterator( + ordered_index_upper_bound(root(),header(),key,x,comp_)); + } + + template + iterator upper_bound( + const CompatibleKey& x,const CompatibleCompare& comp)const + { + return make_iterator( + ordered_index_upper_bound(root(),header(),key,x,comp)); + } + + template + std::pair equal_range( + const CompatibleKey& x)const + { + std::pair p= + ordered_index_equal_range(root(),header(),key,x,comp_); + return std::pair( + make_iterator(p.first),make_iterator(p.second)); + } + + template + std::pair equal_range( + const CompatibleKey& x,const CompatibleCompare& comp)const + { + std::pair p= + ordered_index_equal_range(root(),header(),key,x,comp); + return std::pair( + make_iterator(p.first),make_iterator(p.second)); + } + + /* range */ + + template + std::pair + range(LowerBounder lower,UpperBounder upper)const + { + typedef typename mpl::if_< + is_same, + BOOST_DEDUCED_TYPENAME mpl::if_< + is_same, + both_unbounded_tag, + lower_unbounded_tag + >::type, + BOOST_DEDUCED_TYPENAME mpl::if_< + is_same, + upper_unbounded_tag, + none_unbounded_tag + >::type + >::type dispatch; + + return range(lower,upper,dispatch()); + } + +BOOST_MULTI_INDEX_PROTECTED_IF_MEMBER_TEMPLATE_FRIENDS: + ordered_index(const ctor_args_list& args_list,const allocator_type& al): + super(args_list.get_tail(),al), + key(tuples::get<0>(args_list.get_head())), + comp_(tuples::get<1>(args_list.get_head())) + { + empty_initialize(); + } + + ordered_index( + const ordered_index& x): + super(x), + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + safe_super(), +#endif + + key(x.key), + comp_(x.comp_) + { + /* Copy ctor just takes the key and compare objects from x. The rest is + * done in a subsequent call to copy_(). + */ + } + + ordered_index( + const ordered_index& x, + do_not_copy_elements_tag): + super(x,do_not_copy_elements_tag()), + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + safe_super(), +#endif + + key(x.key), + comp_(x.comp_) + { + empty_initialize(); + } + + ~ordered_index() + { + /* the container is guaranteed to be empty by now */ + } + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + iterator make_iterator(node_type* node){return iterator(node,this);} + const_iterator make_iterator(node_type* node)const + {return const_iterator(node,const_cast(this));} +#else + iterator make_iterator(node_type* node){return iterator(node);} + const_iterator make_iterator(node_type* node)const + {return const_iterator(node);} +#endif + + void copy_( + const ordered_index& x, + const copy_map_type& map) + { + if(!x.root()){ + empty_initialize(); + } + else{ + header()->color()=x.header()->color(); + + node_type* root_cpy=map.find(static_cast(x.root())); + header()->parent()=root_cpy->impl(); + + node_type* leftmost_cpy=map.find( + static_cast(x.leftmost())); + header()->left()=leftmost_cpy->impl(); + + node_type* rightmost_cpy=map.find( + static_cast(x.rightmost())); + header()->right()=rightmost_cpy->impl(); + + typedef typename copy_map_type::const_iterator copy_map_iterator; + for(copy_map_iterator it=map.begin(),it_end=map.end();it!=it_end;++it){ + node_type* org=it->first; + node_type* cpy=it->second; + + cpy->color()=org->color(); + + node_impl_pointer parent_org=org->parent(); + if(parent_org==node_impl_pointer(0))cpy->parent()=node_impl_pointer(0); + else{ + node_type* parent_cpy=map.find( + static_cast(node_type::from_impl(parent_org))); + cpy->parent()=parent_cpy->impl(); + if(parent_org->left()==org->impl()){ + parent_cpy->left()=cpy->impl(); + } + else if(parent_org->right()==org->impl()){ + /* header() does not satisfy this nor the previous check */ + parent_cpy->right()=cpy->impl(); + } + } + + if(org->left()==node_impl_pointer(0)) + cpy->left()=node_impl_pointer(0); + if(org->right()==node_impl_pointer(0)) + cpy->right()=node_impl_pointer(0); + } + } + + super::copy_(x,map); + } + + template + node_type* insert_(value_param_type v,node_type* x,Variant variant) + { + link_info inf; + if(!link_point(key(v),inf,Category())){ + return node_type::from_impl(inf.pos); + } + + node_type* res=static_cast(super::insert_(v,x,variant)); + if(res==x){ + node_impl_type::link(x->impl(),inf.side,inf.pos,header()->impl()); + } + return res; + } + + template + node_type* insert_( + value_param_type v,node_type* position,node_type* x,Variant variant) + { + link_info inf; + if(!hinted_link_point(key(v),position,inf,Category())){ + return node_type::from_impl(inf.pos); + } + + node_type* res=static_cast(super::insert_(v,position,x,variant)); + if(res==x){ + node_impl_type::link(x->impl(),inf.side,inf.pos,header()->impl()); + } + return res; + } + + void erase_(node_type* x) + { + node_impl_type::rebalance_for_erase( + x->impl(),header()->parent(),header()->left(),header()->right()); + super::erase_(x); + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + detach_iterators(x); +#endif + } + + void delete_all_nodes_() + { + delete_all_nodes(root()); + } + + void clear_() + { + super::clear_(); + empty_initialize(); + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + safe_super::detach_dereferenceable_iterators(); +#endif + } + + void swap_(ordered_index& x) + { + std::swap(key,x.key); + std::swap(comp_,x.comp_); + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + safe_super::swap(x); +#endif + + super::swap_(x); + } + + void swap_elements_( + ordered_index& x) + { +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + safe_super::swap(x); +#endif + + super::swap_elements_(x); + } + + template + bool replace_(value_param_type v,node_type* x,Variant variant) + { + if(in_place(v,x,Category())){ + return super::replace_(v,x,variant); + } + + node_type* next=x; + node_type::increment(next); + + node_impl_type::rebalance_for_erase( + x->impl(),header()->parent(),header()->left(),header()->right()); + + BOOST_TRY{ + link_info inf; + if(link_point(key(v),inf,Category())&&super::replace_(v,x,variant)){ + node_impl_type::link(x->impl(),inf.side,inf.pos,header()->impl()); + return true; + } + node_impl_type::restore(x->impl(),next->impl(),header()->impl()); + return false; + } + BOOST_CATCH(...){ + node_impl_type::restore(x->impl(),next->impl(),header()->impl()); + BOOST_RETHROW; + } + BOOST_CATCH_END + } + + bool modify_(node_type* x) + { + bool b; + BOOST_TRY{ + b=in_place(x->value(),x,Category()); + } + BOOST_CATCH(...){ + erase_(x); + BOOST_RETHROW; + } + BOOST_CATCH_END + if(!b){ + node_impl_type::rebalance_for_erase( + x->impl(),header()->parent(),header()->left(),header()->right()); + BOOST_TRY{ + link_info inf; + if(!link_point(key(x->value()),inf,Category())){ + super::erase_(x); + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + detach_iterators(x); +#endif + return false; + } + node_impl_type::link(x->impl(),inf.side,inf.pos,header()->impl()); + } + BOOST_CATCH(...){ + super::erase_(x); + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + detach_iterators(x); +#endif + + BOOST_RETHROW; + } + BOOST_CATCH_END + } + + BOOST_TRY{ + if(!super::modify_(x)){ + node_impl_type::rebalance_for_erase( + x->impl(),header()->parent(),header()->left(),header()->right()); + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + detach_iterators(x); +#endif + + return false; + } + else return true; + } + BOOST_CATCH(...){ + node_impl_type::rebalance_for_erase( + x->impl(),header()->parent(),header()->left(),header()->right()); + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + detach_iterators(x); +#endif + + BOOST_RETHROW; + } + BOOST_CATCH_END + } + + bool modify_rollback_(node_type* x) + { + if(in_place(x->value(),x,Category())){ + return super::modify_rollback_(x); + } + + node_type* next=x; + node_type::increment(next); + + node_impl_type::rebalance_for_erase( + x->impl(),header()->parent(),header()->left(),header()->right()); + + BOOST_TRY{ + link_info inf; + if(link_point(key(x->value()),inf,Category())&& + super::modify_rollback_(x)){ + node_impl_type::link(x->impl(),inf.side,inf.pos,header()->impl()); + return true; + } + node_impl_type::restore(x->impl(),next->impl(),header()->impl()); + return false; + } + BOOST_CATCH(...){ + node_impl_type::restore(x->impl(),next->impl(),header()->impl()); + BOOST_RETHROW; + } + BOOST_CATCH_END + } + +#if !defined(BOOST_MULTI_INDEX_DISABLE_SERIALIZATION) + /* serialization */ + + template + void save_( + Archive& ar,const unsigned int version,const index_saver_type& sm)const + { + save_(ar,version,sm,Category()); + } + + template + void load_(Archive& ar,const unsigned int version,const index_loader_type& lm) + { + load_(ar,version,lm,Category()); + } +#endif + +#if defined(BOOST_MULTI_INDEX_ENABLE_INVARIANT_CHECKING) + /* invariant stuff */ + + bool invariant_()const + { + if(size()==0||begin()==end()){ + if(size()!=0||begin()!=end()|| + header()->left()!=header()->impl()|| + header()->right()!=header()->impl())return false; + } + else{ + if((size_type)std::distance(begin(),end())!=size())return false; + + std::size_t len=node_impl_type::black_count( + leftmost()->impl(),root()->impl()); + for(const_iterator it=begin(),it_end=end();it!=it_end;++it){ + node_type* x=it.get_node(); + node_type* left_x=node_type::from_impl(x->left()); + node_type* right_x=node_type::from_impl(x->right()); + + if(x->color()==red){ + if((left_x&&left_x->color()==red)|| + (right_x&&right_x->color()==red))return false; + } + if(left_x&&comp_(key(x->value()),key(left_x->value())))return false; + if(right_x&&comp_(key(right_x->value()),key(x->value())))return false; + if(!left_x&&!right_x&& + node_impl_type::black_count(x->impl(),root()->impl())!=len) + return false; + } + + if(leftmost()->impl()!=node_impl_type::minimum(root()->impl())) + return false; + if(rightmost()->impl()!=node_impl_type::maximum(root()->impl())) + return false; + } + + return super::invariant_(); + } + + + /* This forwarding function eases things for the boost::mem_fn construct + * in BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT. Actually, + * final_check_invariant is already an inherited member function of + * ordered_index. + */ + void check_invariant_()const{this->final_check_invariant_();} +#endif + +private: + node_type* header()const{return this->final_header();} + node_type* root()const{return node_type::from_impl(header()->parent());} + node_type* leftmost()const{return node_type::from_impl(header()->left());} + node_type* rightmost()const{return node_type::from_impl(header()->right());} + + void empty_initialize() + { + header()->color()=red; + /* used to distinguish header() from root, in iterator.operator++ */ + + header()->parent()=node_impl_pointer(0); + header()->left()=header()->impl(); + header()->right()=header()->impl(); + } + + struct link_info + { + link_info():side(to_left){} + + ordered_index_side side; + node_impl_pointer pos; + }; + + bool link_point(key_param_type k,link_info& inf,ordered_unique_tag) + { + node_type* y=header(); + node_type* x=root(); + bool c=true; + while(x){ + y=x; + c=comp_(k,key(x->value())); + x=node_type::from_impl(c?x->left():x->right()); + } + node_type* yy=y; + if(c){ + if(yy==leftmost()){ + inf.side=to_left; + inf.pos=y->impl(); + return true; + } + else node_type::decrement(yy); + } + + if(comp_(key(yy->value()),k)){ + inf.side=c?to_left:to_right; + inf.pos=y->impl(); + return true; + } + else{ + inf.pos=yy->impl(); + return false; + } + } + + bool link_point(key_param_type k,link_info& inf,ordered_non_unique_tag) + { + node_type* y=header(); + node_type* x=root(); + bool c=true; + while (x){ + y=x; + c=comp_(k,key(x->value())); + x=node_type::from_impl(c?x->left():x->right()); + } + inf.side=c?to_left:to_right; + inf.pos=y->impl(); + return true; + } + + bool lower_link_point(key_param_type k,link_info& inf,ordered_non_unique_tag) + { + node_type* y=header(); + node_type* x=root(); + bool c=false; + while (x){ + y=x; + c=comp_(key(x->value()),k); + x=node_type::from_impl(c?x->right():x->left()); + } + inf.side=c?to_right:to_left; + inf.pos=y->impl(); + return true; + } + + bool hinted_link_point( + key_param_type k,node_type* position,link_info& inf,ordered_unique_tag) + { + if(position->impl()==header()->left()){ + if(size()>0&&comp_(k,key(position->value()))){ + inf.side=to_left; + inf.pos=position->impl(); + return true; + } + else return link_point(k,inf,ordered_unique_tag()); + } + else if(position==header()){ + if(comp_(key(rightmost()->value()),k)){ + inf.side=to_right; + inf.pos=rightmost()->impl(); + return true; + } + else return link_point(k,inf,ordered_unique_tag()); + } + else{ + node_type* before=position; + node_type::decrement(before); + if(comp_(key(before->value()),k)&&comp_(k,key(position->value()))){ + if(before->right()==node_impl_pointer(0)){ + inf.side=to_right; + inf.pos=before->impl(); + return true; + } + else{ + inf.side=to_left; + inf.pos=position->impl(); + return true; + } + } + else return link_point(k,inf,ordered_unique_tag()); + } + } + + bool hinted_link_point( + key_param_type k,node_type* position,link_info& inf,ordered_non_unique_tag) + { + if(position->impl()==header()->left()){ + if(size()>0&&!comp_(key(position->value()),k)){ + inf.side=to_left; + inf.pos=position->impl(); + return true; + } + else return lower_link_point(k,inf,ordered_non_unique_tag()); + } + else if(position==header()){ + if(!comp_(k,key(rightmost()->value()))){ + inf.side=to_right; + inf.pos=rightmost()->impl(); + return true; + } + else return link_point(k,inf,ordered_non_unique_tag()); + } + else{ + node_type* before=position; + node_type::decrement(before); + if(!comp_(k,key(before->value()))){ + if(!comp_(key(position->value()),k)){ + if(before->right()==node_impl_pointer(0)){ + inf.side=to_right; + inf.pos=before->impl(); + return true; + } + else{ + inf.side=to_left; + inf.pos=position->impl(); + return true; + } + } + else return lower_link_point(k,inf,ordered_non_unique_tag()); + } + else return link_point(k,inf,ordered_non_unique_tag()); + } + } + + void delete_all_nodes(node_type* x) + { + if(!x)return; + + delete_all_nodes(node_type::from_impl(x->left())); + delete_all_nodes(node_type::from_impl(x->right())); + this->final_delete_node_(static_cast(x)); + } + + bool in_place(value_param_type v,node_type* x,ordered_unique_tag) + { + node_type* y; + if(x!=leftmost()){ + y=x; + node_type::decrement(y); + if(!comp_(key(y->value()),key(v)))return false; + } + + y=x; + node_type::increment(y); + return y==header()||comp_(key(v),key(y->value())); + } + + bool in_place(value_param_type v,node_type* x,ordered_non_unique_tag) + { + node_type* y; + if(x!=leftmost()){ + y=x; + node_type::decrement(y); + if(comp_(key(v),key(y->value())))return false; + } + + y=x; + node_type::increment(y); + return y==header()||!comp_(key(y->value()),key(v)); + } + +#if defined(BOOST_MULTI_INDEX_ENABLE_SAFE_MODE) + void detach_iterators(node_type* x) + { + iterator it=make_iterator(x); + safe_mode::detach_equivalent_iterators(it); + } +#endif + + template + std::pair emplace_impl(BOOST_MULTI_INDEX_FUNCTION_PARAM_PACK) + { + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + std::pairp= + this->final_emplace_(BOOST_MULTI_INDEX_FORWARD_PARAM_PACK); + return std::pair(make_iterator(p.first),p.second); + } + + template + iterator emplace_hint_impl( + iterator position,BOOST_MULTI_INDEX_FUNCTION_PARAM_PACK) + { + BOOST_MULTI_INDEX_CHECK_VALID_ITERATOR(position); + BOOST_MULTI_INDEX_CHECK_IS_OWNER(position,*this); + BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT; + std::pairp= + this->final_emplace_hint_( + static_cast(position.get_node()), + BOOST_MULTI_INDEX_FORWARD_PARAM_PACK); + return make_iterator(p.first); + } + + template + std::pair + range(LowerBounder lower,UpperBounder upper,none_unbounded_tag)const + { + node_type* y=header(); + node_type* z=root(); + + while(z){ + if(!lower(key(z->value()))){ + z=node_type::from_impl(z->right()); + } + else if(!upper(key(z->value()))){ + y=z; + z=node_type::from_impl(z->left()); + } + else{ + return std::pair( + make_iterator( + lower_range(node_type::from_impl(z->left()),z,lower)), + make_iterator( + upper_range(node_type::from_impl(z->right()),y,upper))); + } + } + + return std::pair(make_iterator(y),make_iterator(y)); + } + + template + std::pair + range(LowerBounder,UpperBounder upper,lower_unbounded_tag)const + { + return std::pair( + begin(), + make_iterator(upper_range(root(),header(),upper))); + } + + template + std::pair + range(LowerBounder lower,UpperBounder,upper_unbounded_tag)const + { + return std::pair( + make_iterator(lower_range(root(),header(),lower)), + end()); + } + + template + std::pair + range(LowerBounder,UpperBounder,both_unbounded_tag)const + { + return std::pair(begin(),end()); + } + + template + node_type * lower_range(node_type* top,node_type* y,LowerBounder lower)const + { + while(top){ + if(lower(key(top->value()))){ + y=top; + top=node_type::from_impl(top->left()); + } + else top=node_type::from_impl(top->right()); + } + + return y; + } + + template + node_type * upper_range(node_type* top,node_type* y,UpperBounder upper)const + { + while(top){ + if(!upper(key(top->value()))){ + y=top; + top=node_type::from_impl(top->left()); + } + else top=node_type::from_impl(top->right()); + } + + return y; + } + +#if !defined(BOOST_MULTI_INDEX_DISABLE_SERIALIZATION) + template + void save_( + Archive& ar,const unsigned int version,const index_saver_type& sm, + ordered_unique_tag)const + { + super::save_(ar,version,sm); + } + + template + void load_( + Archive& ar,const unsigned int version,const index_loader_type& lm, + ordered_unique_tag) + { + super::load_(ar,version,lm); + } + + template + void save_( + Archive& ar,const unsigned int version,const index_saver_type& sm, + ordered_non_unique_tag)const + { + typedef duplicates_iterator dup_iterator; + + sm.save( + dup_iterator(begin().get_node(),end().get_node(),value_comp()), + dup_iterator(end().get_node(),value_comp()), + ar,version); + super::save_(ar,version,sm); + } + + template + void load_( + Archive& ar,const unsigned int version,const index_loader_type& lm, + ordered_non_unique_tag) + { + lm.load( + ::boost::bind(&ordered_index::rearranger,this,_1,_2), + ar,version); + super::load_(ar,version,lm); + } + + void rearranger(node_type* position,node_type *x) + { + if(!position||comp_(key(position->value()),key(x->value()))){ + position=lower_bound(key(x->value())).get_node(); + } + else if(comp_(key(x->value()),key(position->value()))){ + /* inconsistent rearrangement */ + throw_exception( + archive::archive_exception( + archive::archive_exception::other_exception)); + } + else node_type::increment(position); + + if(position!=x){ + node_impl_type::rebalance_for_erase( + x->impl(),header()->parent(),header()->left(),header()->right()); + node_impl_type::restore( + x->impl(),position->impl(),header()->impl()); + } + } +#endif /* serialization */ + + key_from_value key; + key_compare comp_; + +#if defined(BOOST_MULTI_INDEX_ENABLE_INVARIANT_CHECKING)&&\ + BOOST_WORKAROUND(__MWERKS__,<=0x3003) +#pragma parse_mfunc_templ reset +#endif +}; + +/* comparison */ + +template< + typename KeyFromValue1,typename Compare1, + typename SuperMeta1,typename TagList1,typename Category1, + typename KeyFromValue2,typename Compare2, + typename SuperMeta2,typename TagList2,typename Category2 +> +bool operator==( + const ordered_index& x, + const ordered_index& y) +{ + return x.size()==y.size()&&std::equal(x.begin(),x.end(),y.begin()); +} + +template< + typename KeyFromValue1,typename Compare1, + typename SuperMeta1,typename TagList1,typename Category1, + typename KeyFromValue2,typename Compare2, + typename SuperMeta2,typename TagList2,typename Category2 +> +bool operator<( + const ordered_index& x, + const ordered_index& y) +{ + return std::lexicographical_compare(x.begin(),x.end(),y.begin(),y.end()); +} + +template< + typename KeyFromValue1,typename Compare1, + typename SuperMeta1,typename TagList1,typename Category1, + typename KeyFromValue2,typename Compare2, + typename SuperMeta2,typename TagList2,typename Category2 +> +bool operator!=( + const ordered_index& x, + const ordered_index& y) +{ + return !(x==y); +} + +template< + typename KeyFromValue1,typename Compare1, + typename SuperMeta1,typename TagList1,typename Category1, + typename KeyFromValue2,typename Compare2, + typename SuperMeta2,typename TagList2,typename Category2 +> +bool operator>( + const ordered_index& x, + const ordered_index& y) +{ + return y +bool operator>=( + const ordered_index& x, + const ordered_index& y) +{ + return !(x +bool operator<=( + const ordered_index& x, + const ordered_index& y) +{ + return !(x>y); +} + +/* specialized algorithms */ + +template< + typename KeyFromValue,typename Compare, + typename SuperMeta,typename TagList,typename Category +> +void swap( + ordered_index& x, + ordered_index& y) +{ + x.swap(y); +} + +} /* namespace multi_index::detail */ + +/* ordered_index specifiers */ + +template +struct ordered_unique +{ + typedef typename detail::ordered_index_args< + Arg1,Arg2,Arg3> index_args; + typedef typename index_args::tag_list_type::type tag_list_type; + typedef typename index_args::key_from_value_type key_from_value_type; + typedef typename index_args::compare_type compare_type; + + template + struct node_class + { + typedef detail::ordered_index_node type; + }; + + template + struct index_class + { + typedef detail::ordered_index< + key_from_value_type,compare_type, + SuperMeta,tag_list_type,detail::ordered_unique_tag> type; + }; +}; + +template +struct ordered_non_unique +{ + typedef detail::ordered_index_args< + Arg1,Arg2,Arg3> index_args; + typedef typename index_args::tag_list_type::type tag_list_type; + typedef typename index_args::key_from_value_type key_from_value_type; + typedef typename index_args::compare_type compare_type; + + template + struct node_class + { + typedef detail::ordered_index_node type; + }; + + template + struct index_class + { + typedef detail::ordered_index< + key_from_value_type,compare_type, + SuperMeta,tag_list_type,detail::ordered_non_unique_tag> type; + }; +}; + +} /* namespace multi_index */ + +} /* namespace boost */ + +/* Boost.Foreach compatibility */ + +template< + typename KeyFromValue,typename Compare, + typename SuperMeta,typename TagList,typename Category +> +inline boost::mpl::true_* boost_foreach_is_noncopyable( + boost::multi_index::detail::ordered_index< + KeyFromValue,Compare,SuperMeta,TagList,Category>*&, + boost::foreach::tag) +{ + return 0; +} + +#undef BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT +#undef BOOST_MULTI_INDEX_ORD_INDEX_CHECK_INVARIANT_OF + +#endif Index: /issm/trunk-jpl/externalpackages/boost/install-1.55-linux-static.sh =================================================================== --- /issm/trunk-jpl/externalpackages/boost/install-1.55-linux-static.sh (revision 24648) +++ /issm/trunk-jpl/externalpackages/boost/install-1.55-linux-static.sh (revision 24649) @@ -16,5 +16,5 @@ VER="1_55_0" -## Evnrionment +## Environment # export CXXFLAGS='-std=c++98' # Setting CXXFLAGS to deal with C++11 incompatibility with Matlab's Boost @@ -34,6 +34,6 @@ rm -rf boost_${VER} -# Copy customized source and configuration files to 'src' driectory -cp configs/1.55/linux/boost/multi_index/ordered_index.hpp src/boost/multi_index +# Copy customized source and configuration files to 'src' directory +cp configs/1.55/boost/multi_index/ordered_index.hpp src/boost/multi_index # Configure @@ -41,6 +41,5 @@ ./bootstrap.sh \ --prefix="${ISSM_DIR}/externalpackages/boost/install" \ - --with-python=python2.7 \ - --with-python-root="${ISSM_DIR}/externalpackages/python/install" + --with-python=python2.7 # Modify project config to enable MPI Index: /issm/trunk-jpl/externalpackages/boost/install-1.55-linux.sh =================================================================== --- /issm/trunk-jpl/externalpackages/boost/install-1.55-linux.sh (revision 24648) +++ /issm/trunk-jpl/externalpackages/boost/install-1.55-linux.sh (revision 24649) @@ -34,6 +34,6 @@ rm -rf boost_${VER} -# Copy customized source and configuration files to 'src' driectory -cp configs/1.55/linux/boost/multi_index/ordered_index.hpp src/boost/multi_index +# Copy customized source and configuration files to 'src' directory +cp configs/1.55/boost/multi_index/ordered_index.hpp src/boost/multi_index # Configure @@ -41,6 +41,5 @@ ./bootstrap.sh \ --prefix="${ISSM_DIR}/externalpackages/boost/install" \ - --with-python=python2.7 \ - --with-python-root="${ISSM_DIR}/externalpackages/python/install" + --with-python=python2.7 # Modify project config to enable MPI Index: sm/trunk-jpl/externalpackages/boost/install-1.55-linux64-static.sh =================================================================== --- /issm/trunk-jpl/externalpackages/boost/install-1.55-linux64-static.sh (revision 24648) +++ (revision ) @@ -1,39 +1,0 @@ -#!/bin/bash -#set -eu -#unhook set -eu because some target do fail and it is not a big deal - -#Note of caution: stop after boostrap phase, and run -#bjam --debug-configuration, to figure out which paths boost is using to include -#python. make sure everyone of these paths is covered by python. If not, just make -#symlinks in externalpackages/python to what boost is expecting. Ther is NO WAY -#to get the boost library to include python support without doing that. - -#Some cleanup -rm -rf install boost_1_55_0 src -mkdir install src - -#Download from ISSM server -$ISSM_DIR/scripts/DownloadExternalPackage.sh https://issm.ess.uci.edu/files/externalpackages/boost_1_55_0.tar.gz boost_1_55_0.tar.gz - -#Untar -tar -zxvf boost_1_55_0.tar.gz - -#Move boost into install directory -mv boost_1_55_0/* src -rm -rf boost_1_55_0 - -#Setting CXXFLAGS to deal with C++11 incompatibility with Matlab's Boost -export CXXFLAGS='-std=c++98' - -#Configure and compile -cd src -./bootstrap.sh \ - --prefix="$ISSM_DIR/externalpackages/boost/install" \ - --with-python=python - -#Compile boost -./bjam toolset=gcc link=static install - -#put bjam into install also -mkdir ../install/bin -cp bjam ../install/bin Index: /issm/trunk-jpl/externalpackages/boost/install-1.55-mac-static.sh =================================================================== --- /issm/trunk-jpl/externalpackages/boost/install-1.55-mac-static.sh (revision 24649) +++ /issm/trunk-jpl/externalpackages/boost/install-1.55-mac-static.sh (revision 24649) @@ -0,0 +1,53 @@ +#!/bin/bash +#set -eu # Do not `run set -eu` because it causes some targets to fail + + +# NOTE: +# - Stop after bootstrap step and run `bjam --debug-configuration` to figure +# out which paths Boost is using to include Python. Make sure that each of +# the listed paths is covered by Python. If not, you must create a symbolic +# link from $ISSM_DIR/externalpackages/python to the location of the file +# that Boost is expecting. There is no way to get the Boost to compile with +# Python otherwise. +# + +## Constants +# +VER="1_55_0" + +## Evnrionment +# +export CXXFLAGS='-std=c++98' # Setting CXXFLAGS to deal with C++11 incompatibility with Matlab's Boost + +# Download source +$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/boost_${VER}.tar.gz" "boost_${VER}.tar.gz" + +# Unpack source +tar -zxvf boost_${VER}.tar.gz + +# Cleanup +rm -rf install src +mkdir install src + +# Move source into 'src' directory +mv boost_${VER}/* src/ +rm -rf boost_${VER} + +# Copy customized source and configuration files to 'src' directory +cp configs/1.55/boost/multi_index/ordered_index.hpp src/boost/multi_index + +# Configure +cd src +./bootstrap.sh \ + --prefix="${ISSM_DIR}/externalpackages/boost/install" \ + --with-python=python2.7 + +# Modify project config to enable MPI +printf "\n# Enable MPI\nusing mpi ;\n" >> project-config.jam + +# Compile and install +./bjam link=static install + +# Copy binary to install directory +mkdir ../install/bin +cp bjam ../install/bin Index: /issm/trunk-jpl/externalpackages/boost/install-1.55-mac.sh =================================================================== --- /issm/trunk-jpl/externalpackages/boost/install-1.55-mac.sh (revision 24649) +++ /issm/trunk-jpl/externalpackages/boost/install-1.55-mac.sh (revision 24649) @@ -0,0 +1,53 @@ +#!/bin/bash +#set -eu # Do not `run set -eu` because it causes some targets to fail + + +# NOTE: +# - Stop after bootstrap step and run `bjam --debug-configuration` to figure +# out which paths Boost is using to include Python. Make sure that each of +# the listed paths is covered by Python. If not, you must create a symbolic +# link from $ISSM_DIR/externalpackages/python to the location of the file +# that Boost is expecting. There is no way to get the Boost to compile with +# Python otherwise. +# + +## Constants +# +VER="1_55_0" + +## Evnrionment +# +export CXXFLAGS='-std=c++98' # Setting CXXFLAGS to deal with C++11 incompatibility with Matlab's Boost + +# Download source +$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/boost_${VER}.tar.gz" "boost_${VER}.tar.gz" + +# Unpack source +tar -zxvf boost_${VER}.tar.gz + +# Cleanup +rm -rf install src +mkdir install src + +# Move source into 'src' directory +mv boost_${VER}/* src/ +rm -rf boost_${VER} + +# Copy customized source and configuration files to 'src' directory +cp configs/1.55/boost/multi_index/ordered_index.hpp src/boost/multi_index + +# Configure +cd src +./bootstrap.sh \ + --prefix="${ISSM_DIR}/externalpackages/boost/install" \ + --with-python=python2.7 + +# Modify project config to enable MPI +printf "\n# Enable MPI\nusing mpi ;\n" >> project-config.jam + +# Compile and install +./bjam install + +# Copy binary to install directory +mkdir ../install/bin +cp bjam ../install/bin Index: /issm/trunk-jpl/externalpackages/dakota/configs/6.2/mac/cmake/BuildDakotaCustom.cmake =================================================================== --- /issm/trunk-jpl/externalpackages/dakota/configs/6.2/mac/cmake/BuildDakotaCustom.cmake (revision 24649) +++ /issm/trunk-jpl/externalpackages/dakota/configs/6.2/mac/cmake/BuildDakotaCustom.cmake (revision 24649) @@ -0,0 +1,95 @@ +############################################################################## +# +# Template CMake Configuration File. +# +############################################################################## +# The following CMake variables represent the minimum set of variables +# that are required to allow Dakota to +# * find all prerequisite third party libraries (TPLs) +# * configure compiler and MPI options +# * set Dakota install path +# +# Instructions: +# 1. Read Dakota/INSTALL - Source Quick Start to use this template file. +# +# 2. Uncomment CMake variables below ONLY for values you need to change for +# your platform. Edit variables as needed. +# +# For example, if you are using a custom install of Boost, installed in +# /home/me/usr/boost, uncomment both CMake Boost variables and edit +# paths: +# set(BOOST_ROOT +# "/home/me/usr/boost" +# CACHE PATH "Use non-standard Boost install" FORCE) +# set( Boost_NO_SYSTEM_PATHS TRUE +# CACHE BOOL "Supress search paths other than BOOST_ROOT" FORCE) +# +# Save file and exit. +# +# 6. Run CMake with script file. At terminal window, type: +# $ cmake -C BuildCustom.cmake $DAK_SRC +# +# If you have not followed instructions in INSTALL -Source Quick Start, +# you will need to replace BuildCustom.cmake with the actual filename of +# this file and $DAK_SRC with the actual path to Dakota source. +# +############################################################################## + +############################################################################## +# Set BLAS, LAPACK library paths ONLY if in non-standard locations +############################################################################## +set( BLAS_LIBS + "$ENV{BLAS_LIBS}" + CACHE FILEPATH "Use non-standard BLAS library path" FORCE ) +set( LAPACK_LIBS + "$ENV{LAPACK_LIBS}" + CACHE FILEPATH "Use non-standard BLAS library path" FORCE ) + +############################################################################## +# Set additional compiler options +# Uncomment and replace with actual compiler flag, e.g. -xxe4.2 +############################################################################## +set( CMAKE_C_FLAGS "${CMAKE_C_FLAGS}" + CACHE STRING "C Flags my platform" ) +set( CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS}" + CACHE STRING "CXX Flags for my platform" ) +set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}" + CACHE STRING "Fortran Flags for my platform" ) + +############################################################################## +# Set MPI options +# Recommended practice is to set DAKOTA_HAVE_MPI and set MPI_CXX_COMPILER +# to a compiler wrapper. +############################################################################## +set( DAKOTA_HAVE_MPI ON + CACHE BOOL "Build with MPI enabled" FORCE) +set( MPI_INCLUDE_PATH "$ENV{MPI_INSTALL}/include" + CACHE FILEPATH "Use MPI headers" FORCE) +set( MPI_LIBRARY "-L$ENV{MPI_INSTALL}/lib -lmpich" + CACHE FILEPATH "Use MPI library" FORCE) + +############################################################################## +# Set Boost path if CMake cannot find your installed version of Boost or +# if you have a custom Boost install location. +############################################################################## +set(BOOST_ROOT + $ENV{BOOST_ROOT} + CACHE PATH "Use non-standard Boost install" FORCE) +set( Boost_NO_SYSTEM_PATHS TRUE + CACHE BOOL "Supress search paths other than BOOST_ROOT" FORCE) + +############################################################################## +# Set Trilinos path if you want have a custom Trilinos install location. If +# not set, the Trilinos package, teuchos, will be build during the Dakota +# build. +############################################################################## +#set( Trilinos_DIR +# "path/to/Trilinos/install" +# CACHE PATH "Path to installed Trilinos" FORCE ) + +############################################################################## +# Customize DAKOTA +############################################################################## +set( CMAKE_INSTALL_PREFIX + $ENV{DAK_INSTALL} + CACHE PATH "Path to Dakota installation" ) Index: /issm/trunk-jpl/externalpackages/dakota/configs/6.2/mac/cmake/DakotaDev.cmake =================================================================== --- /issm/trunk-jpl/externalpackages/dakota/configs/6.2/mac/cmake/DakotaDev.cmake (revision 24649) +++ /issm/trunk-jpl/externalpackages/dakota/configs/6.2/mac/cmake/DakotaDev.cmake (revision 24649) @@ -0,0 +1,18 @@ +# CMake options for DAKOTA developer builds + +# Developer options +#set(DAKOTA_HAVE_MPI TRUE CACHE BOOL "Enable MPI in DAKOTA?") +set(ENABLE_DAKOTA_DOCS FALSE CACHE BOOL "Enable DAKOTA documentation build") +set(ENABLE_SPEC_MAINT FALSE CACHE BOOL + "Enable DAKOTA specification maintenance mode?") +set(PECOS_ENABLE_TESTS FALSE CACHE BOOL "Enable Pecos-specific tests?") + +# Not included from Mike's configs, but may help some + +# Disable optional X graphics +#-DHAVE_X_GRAPHICS:BOOL=FALSE +set(HAVE_X_GRAPHICS OFF CACHE BOOL "Disable dependency on X libraries" FORCE) + +# CMake 2.8.6 has problems with RHEL6/Boost -- the following is a workaround +#-DBoost_NO_BOOST_CMAKE=ON +#set(Boost_NO_BOOST_CMAKE ON CACHE BOOL "Obtain desired behavior on RHEL6" FORCE) Index: /issm/trunk-jpl/externalpackages/dakota/configs/6.2/mac/packages/VPISparseGrid/src/sandia_rules.cpp =================================================================== --- /issm/trunk-jpl/externalpackages/dakota/configs/6.2/mac/packages/VPISparseGrid/src/sandia_rules.cpp (revision 24649) +++ /issm/trunk-jpl/externalpackages/dakota/configs/6.2/mac/packages/VPISparseGrid/src/sandia_rules.cpp (revision 24649) @@ -0,0 +1,25739 @@ +# include "sandia_rules.hpp" + +# include +# include +# include +# include +# include + +namespace webbur +{ +//****************************************************************************80 + +void binary_vector_next ( int n, int bvec[] ) + +//****************************************************************************80 +// +// Purpose: +// +// BINARY_VECTOR_NEXT generates the next binary vector. +// +// Discussion: +// +// A binary vector is a vector whose entries are 0 or 1. +// +// The user inputs an initial zero vector to start. The program returns +// the "next" vector. +// +// The vectors are produced in the order: +// +// ( 0, 0, 0, ..., 0 ) +// ( 1, 0, 0, ..., 0 ) +// ( 0, 1, 0, ..., 0 ) +// ( 1, 1, 0, ..., 0 ) +// ( 0, 0, 1, ..., 0 ) +// ( 1, 0, 1, ..., 0 ) +// ... +// ( 1, 1, 1, ..., 1) +// +// and the "next" vector after (1,1,...,1) is (0,0,...,0). That is, +// we allow wrap around. +// +// Example: +// +// N = 3 +// +// Input Output +// ----- ------ +// 0 0 0 => 1 0 0 +// 1 0 0 => 0 1 0 +// 0 1 0 => 1 1 0 +// 1 1 0 => 0 0 1 +// 0 0 1 => 1 0 1 +// 1 0 1 => 0 1 1 +// 0 1 1 => 1 1 1 +// 1 1 1 => 0 0 0 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 04 September 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the dimension of the vectors. +// +// Input/output, int BVEC[N], on output, the successor +// to the input vector. +// +{ + int i; + + for ( i = 0; i < n; i++ ) + { + if ( bvec[i] == 1 ) + { + bvec[i] = 0; + } + else + { + bvec[i] = 1; + break; + } + } + return; +} +//****************************************************************************80 + +void ccn_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CCN_COMPUTE computes a nested Clenshaw Curtis quadrature rule. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::ccn_compute_points ( n, x ); + webbur::ccn_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void ccn_compute_np ( int n, int np, double p[], double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CCN_COMPUTE_NP computes a nested Clenshaw Curtis quadrature rule. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::ccn_compute_points ( n, x ); + webbur::ccn_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void ccn_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CCN_COMPUTE_POINTS: compute nested Clenshaw Curtis points. +// +// Discussion: +// +// We want to compute the following sequence: +// +// 1/2, +// 0, 1 +// 1/4, 3/4 +// 1/8, 3/8, 5/8, 7/8, +// 1/16, 3/16, 5/16, 7/16, 9/16, 11/16, 13/16, 15/16, and so on. +// +// But we would prefer that the numbers in each row be regrouped in pairs +// that are symmetric about 1/2, with the number above 1/2 coming first. +// Thus, the last row might become: +// (9/16, 7/16), (11/16, 5/16), ..., (15/16, 1/16). +// +// Once we have our sequence, we apply the Chebyshev transformation +// which maps [0,1] to [-1,+1]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 06 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of elements to compute. +// +// Output, double X[N], the elements of the sequence. +// +{ + int d; + int i; + int k; + int m; + double pi = 3.141592653589793; + int td; + int tu; +// +// Handle first three entries specially. +// + if ( 1 <= n ) + { + x[0] = 0.5; + } + + if ( 2 <= n ) + { + x[1] = 1.0; + } + + if ( 3 <= n ) + { + x[2] = 0.0; + } + + m = 3; + d = 2; + + while ( m < n ) + { + tu = d + 1; + td = d - 1; + + k = webbur::i4_min ( d, n - m ); + + for ( i = 1; i <= k; i++ ) + { + if ( ( i % 2 ) == 1 ) + { + x[m+i-1] = tu / 2.0 / ( double ) ( k ); + tu = tu + 2; + } + else + { + x[m+i-1] = td / 2.0 / ( double ) ( k ); + td = td - 2; + } + } + m = m + k; + d = d * 2; + } +// +// Apply the Chebyshev transformation. +// + for ( i = 0; i < n; i++ ) + { + x[i] = std::cos ( x[i] * pi ); + } + x[0] = 0.0; + + if ( 2 <= n ) + { + x[1] = -1.0; + } + + if ( 3 <= n ) + { + x[2] = +1.0; + } + + return; +} +//****************************************************************************80 + +void ccn_compute_points_np ( int n, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CCN_COMPUTE_POINTS_NP: nested Clenshaw Curtis quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + webbur::ccn_compute_points ( n, x ); + + return; +} +//****************************************************************************80 + +void ccn_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CCN_COMPUTE_WEIGHTS: weights for nested Clenshaw Curtis rule. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order of the rule. +// +// Output, double W[N], the weights. +// +{ + double *x; + double x_max; + double x_min; + + x = new double[n]; + + webbur::ccn_compute_points ( n, x ); +// +// Get the weights. +// + x_min = -1.0; + x_max = +1.0; + + webbur::nc_compute ( n, x_min, x_max, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void ccn_compute_weights_np ( int n, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CCN_COMPUTE_WEIGHTS_NP: nested Clenshaw Curtis quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + webbur::ccn_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void chebyshev1_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV1_COMPUTE computes a Chebyshev type 1 quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) F(X) / sqrt ( 1 - x^2 ) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= N ) W(I) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + int i; + double pi = 3.141592653589793; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "CHEBYSHEV1_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::exit ( 1 ); + } + + for ( i = 0; i < n; i++ ) + { + w[i] = pi / ( double ) ( n ); + } + for ( i = 0; i < n; i++ ) + { + x[i] = std::cos ( pi * ( double ) ( 2 * n - 1 - 2 * i ) + / ( double ) ( 2 * n ) ); + } + if ( ( n % 2 ) == 1 ) + { + x[(n-1)/2] = 0.0; + } + + return; +} +//****************************************************************************80 + +void chebyshev1_compute_np ( int n, int np, double p[], double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV1_COMPUTE_NP computes a Chebyshev type 1 quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) F(X) / sqrt ( 1 - x^2 ) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= N ) W(I) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::chebyshev1_compute ( n, x, w ); + + return; +} +//****************************************************************************80 + +void chebyshev1_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV1_COMPUTE_POINTS computes Chebyshev type 1 quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +{ + int i; + double pi = 3.141592653589793; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "CHEBYSHEV1_COMPUTE_POINTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::exit ( 1 ); + } + + for ( i = 0; i < n; i++ ) + { + x[i] = std::cos ( pi * ( double ) ( 2 * n - 1 - 2 * i ) + / ( double ) ( 2 * n ) ); + } + if ( ( n % 2 ) == 1 ) + { + x[(n-1)/2] = 0.0; + } + + return; +} +//****************************************************************************80 + +void chebyshev1_compute_points_np ( int n, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV1_COMPUTE_POINTS_NP computes Chebyshev type 1 quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + webbur::chebyshev1_compute_points ( n, x ); + + return; +} +//****************************************************************************80 + +void chebyshev1_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV1_COMPUTE_WEIGHTS computes Chebyshev type 1 quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double W[N], the weights. +// +{ + int i; + double pi = 3.141592653589793; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "CHEBYSHEV1_COMPUTE_WEIGHTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::exit ( 1 ); + } + + for ( i = 0; i < n; i++ ) + { + w[i] = pi / ( double ) ( n ); + } + + return; +} +//****************************************************************************80 + +void chebyshev1_compute_weights_np ( int n, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV1_COMPUTE_WEIGHTS_NP: Chebyshev type 1 quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + webbur::chebyshev1_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +double chebyshev1_integral ( int expon ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV1_INTEGRAL evaluates a monomial Chebyshev type 1 integral. +// +// Discussion: +// +// The integral: +// +// integral ( -1 <= x <= +1 ) x^n / sqrt ( 1 - x^2 ) dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 26 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int EXPON, the exponent. +// +// Output, double CHEBYSHEV1_INTEGRAL, the value of the exact integral. +// +{ + double bot; + double exact; + int i; + double pi = 3.141592653589793; + double top; +// +// Get the exact value of the integral. +// + if ( ( expon % 2 ) == 0 ) + { + top = 1; + bot = 1; + for ( i = 2; i <= expon; i = i + 2 ) + { + top = top * ( i - 1 ); + bot = bot * i; + } + + exact = pi * ( double ) ( top ) / ( double ) ( bot ); + } + else + { + exact = 0.0; + } + + return exact; +} +//****************************************************************************80 + +void chebyshev2_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV2_COMPUTE computes a Chebyshev type 2 quadrature rule. +// +// Discussion: +// +// The integral: +// +// integral ( -1 <= x <= 1 ) f(x) sqrt ( 1 - x^2 ) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double angle; + int i; + double pi = 3.141592653589793; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "CHEBYSHEV2_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::exit ( 1 ); + } + + for ( i = 0; i < n; i++ ) + { + angle = pi * ( double ) ( n - i ) / ( double ) ( n + 1 ); + w[i] = pi / ( double ) ( n + 1 ) * std::pow ( std::sin ( angle ), 2 ); + x[i] = std::cos ( angle ); + } + + if ( ( n % 2 ) == 1 ) + { + x[(n-1)/2] = 0.0; + } + + return; +} +//****************************************************************************80 + +void chebyshev2_compute_np ( int n, int np, double p[], double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV2_COMPUTE_NP computes a Chebyshev type 2 quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) F(X) sqrt ( 1 - x^2 ) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= N ) W(I) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::chebyshev2_compute ( n, x, w ); + + return; +} +//****************************************************************************80 + +void chebyshev2_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV2_COMPUTE_POINTS computes Chebyshev type 2 quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +{ + double angle; + int i; + double pi = 3.141592653589793; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "CHEBYSHEV2_COMPUTE_POINTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::exit ( 1 ); + } + + for ( i = 0; i < n; i++ ) + { + angle = pi * ( double ) ( n - i ) / ( double ) ( n + 1 ); + x[i] = std::cos ( angle ); + } + + if ( ( n % 2 ) == 1 ) + { + x[(n-1)/2] = 0.0; + } + + return; +} +//****************************************************************************80 + +void chebyshev2_compute_points_np ( int n, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV2_COMPUTE_POINTS_NP computes Chebyshev type 2 quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 03 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + webbur::chebyshev2_compute_points ( n, x ); + + return; +} +//****************************************************************************80 + +void chebyshev2_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV2_COMPUTE_WEIGHTS computes Chebyshev type 2 quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double W[N], the weights. +// +{ + double angle; + int i; + double pi = 3.141592653589793; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "CHEBYSHEV2_COMPUTE_WEIGHTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::exit ( 1 ); + } + + for ( i = 0; i < n; i++ ) + { + angle = pi * ( double ) ( n - i ) / ( double ) ( n + 1 ); + w[i] = pi / ( double ) ( n + 1 ) * std::pow ( std::sin ( angle ), 2 ); + } + + return; +} +//****************************************************************************80 + +void chebyshev2_compute_weights_np ( int n, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV2_COMPUTE_WEIGHTS_NP: Chebyshev type 2 quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + webbur::chebyshev2_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +double chebyshev2_integral ( int expon ) + +//****************************************************************************80 +// +// Purpose: +// +// CHEBYSHEV2_INTEGRAL evaluates a monomial Chebyshev type 2 integral. +// +// Discussion: +// +// The integral: +// +// integral ( -1 <= x <= +1 ) x^n * sqrt ( 1 - x^2 ) dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 26 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int EXPON, the exponent. +// +// Output, double CHEBYSHEV2_INTEGRAL, the value of the exact integral. +// +{ + double bot; + double exact; + int i; + double pi = 3.141592653589793; + double top; +// +// Get the exact value of the integral. +// + if ( ( expon % 2 ) == 0 ) + { + top = 1; + bot = 1; + for ( i = 2; i <= expon; i = i + 2 ) + { + top = top * ( i - 1 ); + bot = bot * i; + } + + bot = bot * ( double ) ( expon + 2 ); + + exact = pi * ( double ) ( top ) / ( double ) ( bot ); + } + else + { + exact = 0.0; + } + return exact; +} +//****************************************************************************80 + +void clenshaw_curtis_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CLENSHAW_CURTIS_COMPUTE computes a Clenshaw Curtis quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= N ) W(I) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 March 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double b; + int i; + int j; + double pi = 3.141592653589793; + double theta; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "CLENSHAW_CURTIS_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::exit ( 1 ); + } + else if ( n == 1 ) + { + x[0] = 0.0; + w[0] = 2.0; + } + else + { + for ( i = 0; i < n; i++ ) + { + x[i] = std::cos ( ( double ) ( n - 1 - i ) * pi + / ( double ) ( n - 1 ) ); + } + x[0] = -1.0; + if ( ( n % 2 ) == 1 ) + { + x[(n-1)/2] = 0.0; + } + x[n-1] = +1.0; + + for ( i = 0; i < n; i++ ) + { + theta = ( double ) ( i ) * pi / ( double ) ( n - 1 ); + + w[i] = 1.0; + + for ( j = 1; j <= ( n - 1 ) / 2; j++ ) + { + if ( 2 * j == ( n - 1 ) ) + { + b = 1.0; + } + else + { + b = 2.0; + } + + w[i] = w[i] - b * std::cos ( 2.0 * ( double ) ( j ) * theta ) + / ( double ) ( 4 * j * j - 1 ); + } + } + + w[0] = w[0] / ( double ) ( n - 1 ); + for ( i = 1; i < n - 1; i++ ) + { + w[i] = 2.0 * w[i] / ( double ) ( n - 1 ); + } + w[n-1] = w[n-1] / ( double ) ( n - 1 ); + } + + return; +} +//****************************************************************************80 + +void clenshaw_curtis_compute_np ( int n, int np, double p[], double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CLENSHAW_CURTIS_COMPUTE_NP computes a Clenshaw Curtis quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= N ) W(I) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::clenshaw_curtis_compute ( n, x, w ); + + return; +} +//****************************************************************************80 + +void clenshaw_curtis_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CLENSHAW_CURTIS_COMPUTE_POINTS computes Clenshaw Curtis quadrature points. +// +// Discussion: +// +// Our convention is that the abscissas are numbered from left to right. +// +// This rule is defined on [-1,1]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double X[N], the abscissas. +// +{ + int index; + double pi = 3.141592653589793; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "CLENSHAW_CURTIS_COMPUTE_POINTS - Fatal error!\n"; + std::cerr << " N < 1.\n"; + std::exit ( 1 ); + } + else if ( n == 1 ) + { + x[0] = 0.0; + } + else + { + for ( index = 1; index <= n; index++ ) + { + x[index-1] = std::cos ( ( double ) ( n - index ) * pi + / ( double ) ( n - 1 ) ); + } + x[0] = -1.0; + if ( ( n % 2 ) == 1 ) + { + x[(n-1)/2] = 0.0; + } + x[n-1] = +1.0; + } + return; +} +//****************************************************************************80 + +void clenshaw_curtis_compute_points_np ( int n, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CLENSHAW_CURTIS_COMPUTE_POINTS_NP: Clenshaw Curtis quadrature points. +// +// Discussion: +// +// Our convention is that the abscissas are numbered from left to right. +// +// This rule is defined on [-1,1]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + webbur::clenshaw_curtis_compute_points ( n, x ); + + return; +} +//****************************************************************************80 + +void clenshaw_curtis_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CLENSHAW_CURTIS_COMPUTE_WEIGHTS computes Clenshaw Curtis quadrature weights. +// +// Discussion: +// +// The user must preallocate space for the output array W. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Charles Clenshaw, Alan Curtis, +// A Method for Numerical Integration on an Automatic Computer, +// Numerische Mathematik, +// Volume 2, Number 1, December 1960, pages 197-205. +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double W[N], the weights. +// +{ + double b; + int i; + int j; + double pi = 3.141592653589793; + double theta; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "CLENSHAW_CURTIS_COMPUTE_WEIGHTS - Fatal error!\n"; + std::cerr << " N < 1.\n"; + std::exit ( 1 ); + } + else if ( n == 1 ) + { + w[0] = 2.0; + return; + } + + for ( i = 1; i <= n; i++ ) + { + theta = ( double ) ( i - 1 ) * pi / ( double ) ( n - 1 ); + + w[i-1] = 1.0; + + for ( j = 1; j <= ( n - 1 ) / 2; j++ ) + { + if ( 2 * j == ( n - 1 ) ) + { + b = 1.0; + } + else + { + b = 2.0; + } + + w[i-1] = w[i-1] - b * std::cos ( 2.0 * ( double ) ( j ) * theta ) + / ( double ) ( 4 * j * j - 1 ); + } + } + + w[0] = w[0] / ( double ) ( n - 1 ); + for ( i = 1; i < n - 1; i++ ) + { + w[i] = 2.0 * w[i] / ( double ) ( n - 1 ); + } + w[n-1] = w[n-1] / ( double ) ( n - 1 ); + + return; +} +//****************************************************************************80 + +void clenshaw_curtis_compute_weights_np ( int n, int np, double p[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// CLENSHAW_CURTIS_COMPUTE_WEIGHTS_NP: Clenshaw Curtis quadrature weights. +// +// Discussion: +// +// The user must preallocate space for the output array W. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Charles Clenshaw, Alan Curtis, +// A Method for Numerical Integration on an Automatic Computer, +// Numerische Mathematik, +// Volume 2, Number 1, December 1960, pages 197-205. +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + webbur::clenshaw_curtis_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void comp_next ( int n, int k, int a[], bool *more, int *h, int *t ) + +//****************************************************************************80 +// +// Purpose: +// +// COMP_NEXT computes the compositions of the integer N into K parts. +// +// Discussion: +// +// A composition of the integer N into K parts is an ordered sequence +// of K nonnegative integers which sum to N. The compositions (1,2,1) +// and (1,1,2) are considered to be distinct. +// +// The routine computes one composition on each call until there are no more. +// For instance, one composition of 6 into 3 parts is +// 3+2+1, another would be 6+0+0. +// +// On the first call to this routine, set MORE = FALSE. The routine +// will compute the first element in the sequence of compositions, and +// return it, as well as setting MORE = TRUE. If more compositions +// are desired, call again, and again. Each time, the routine will +// return with a new composition. +// +// However, when the LAST composition in the sequence is computed +// and returned, the routine will reset MORE to FALSE, signaling that +// the end of the sequence has been reached. +// +// This routine originally used a SAVE statement to maintain the +// variables H and T. I have decided that it is safer +// to pass these variables as arguments, even though the user should +// never alter them. This allows this routine to safely shuffle +// between several ongoing calculations. +// +// +// There are 28 compositions of 6 into three parts. This routine will +// produce those compositions in the following order: +// +// I A +// - --------- +// 1 6 0 0 +// 2 5 1 0 +// 3 4 2 0 +// 4 3 3 0 +// 5 2 4 0 +// 6 1 5 0 +// 7 0 6 0 +// 8 5 0 1 +// 9 4 1 1 +// 10 3 2 1 +// 11 2 3 1 +// 12 1 4 1 +// 13 0 5 1 +// 14 4 0 2 +// 15 3 1 2 +// 16 2 2 2 +// 17 1 3 2 +// 18 0 4 2 +// 19 3 0 3 +// 20 2 1 3 +// 21 1 2 3 +// 22 0 3 3 +// 23 2 0 4 +// 24 1 1 4 +// 25 0 2 4 +// 26 1 0 5 +// 27 0 1 5 +// 28 0 0 6 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 02 July 2008 +// +// Author: +// +// Original FORTRAN77 version by Albert Nijenhuis, Herbert Wilf. +// C++ version by John Burkardt. +// +// Reference: +// +// Albert Nijenhuis, Herbert Wilf, +// Combinatorial Algorithms for Computers and Calculators, +// Second Edition, +// Academic Press, 1978, +// ISBN: 0-12-519260-6, +// LC: QA164.N54. +// +// Parameters: +// +// Input, int N, the integer whose compositions are desired. +// +// Input, int K, the number of parts in the composition. +// +// Input/output, int A[K], the parts of the composition. +// +// Input/output, bool *MORE. +// Set MORE = FALSE on first call. It will be reset to TRUE on return +// with a new composition. Each new call returns another composition until +// MORE is set to FALSE when the last composition has been computed +// and returned. +// +// Input/output, int *H, *T, two internal parameters needed for the +// computation. The user should allocate space for these in the calling +// program, include them in the calling sequence, but never alter them! +// +{ + int i; + + if ( !( *more ) ) + { + *t = n; + *h = 0; + a[0] = n; + for ( i = 1; i < k; i++ ) + { + a[i] = 0; + } + } + else + { + if ( 1 < *t ) + { + *h = 0; + } + *h = *h + 1; + *t = a[*h-1]; + a[*h-1] = 0; + a[0] = *t - 1; + a[*h] = a[*h] + 1; + } + + *more = ( a[k-1] != n ); + + return; +} +//****************************************************************************80 + +double cpu_time ( ) + +//****************************************************************************80 +// +// Purpose: +// +// CPU_TIME reports the elapsed CPU time. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 26 July 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Output, double CPU_TIME, the current total elapsed CPU time in second. +// +{ + double value; + + value = ( double ) std::clock ( ) / ( double ) CLOCKS_PER_SEC; + + return value; +} +//****************************************************************************80 + +void dif_deriv ( int nd, double xd[], double yd[], int *ndp, double xdp[], + double ydp[] ) + +//****************************************************************************80 +// +// Purpose: +// +// DIF_DERIV computes the derivative of a polynomial in divided difference form. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 June 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Carl deBoor, +// A Practical Guide to Splines, +// Springer, 2001, +// ISBN: 0387953663, +// LC: QA1.A647.v27. +// +// Parameters: +// +// Input, int ND, the size of the input table. +// +// Input, double XD[ND], the abscissas for the divided +// difference table. +// +// Input, double YD[ND], the divided difference table. +// +// Output, int *NDP, the size of the output table, which is ND-1. +// +// Input, double XDP[NP], the abscissas for the divided +// difference table for the derivative. +// +// Output, double YDP[NDP], the divided difference +// table for the derivative. +// +{ + int i; + double *xd_temp; + double *yd_temp; +// +// Using a temporary copy of the difference table, shift the +// abscissas to zero. +// + xd_temp = new double[nd]; + yd_temp = new double[nd]; + + for ( i = 0; i < nd; i++ ) + { + xd_temp[i] = xd[i]; + } + for ( i = 0; i < nd; i++ ) + { + yd_temp[i] = yd[i]; + } + + webbur::dif_shift_zero ( nd, xd_temp, yd_temp ); +// +// Construct the derivative. +// + *ndp = nd - 1; + + for ( i = 0; i < *ndp; i++ ) + { + xdp[i] = 0.0; + } + + for ( i = 0; i < *ndp; i++ ) + { + ydp[i] = ( double ) ( i + 1 ) * yd_temp[i+1]; + } + + delete [] xd_temp; + delete [] yd_temp; + + return; +} +//****************************************************************************80 + +void dif_shift_x ( int nd, double xd[], double yd[], double xv ) + +//****************************************************************************80 +// +// Purpose: +// +// DIF_SHIFT_X replaces one abscissa of a divided difference table with a new one. +// +// Discussion: +// +// This routine shifts the representation of a divided difference polynomial by +// dropping the last X value in XD, and adding a new X value to the +// beginning of the Xd array, suitably modifying the coefficients stored +// in YD. +// +// The representation of the polynomial is changed, but the polynomial itself +// should be identical. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 June 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Carl deBoor, +// A Practical Guide to Splines, +// Springer, 2001, +// ISBN: 0387953663, +// LC: QA1.A647.v27. +// +// Parameters: +// +// Input, int ND, the number of divided difference coefficients, and +// the number of entries in XD. +// +// Input/output, double XD[ND], the X values used in the representation of +// the divided difference polynomial. After a call to this routine, the +// last entry of XD has been dropped, the other +// entries have shifted up one index, and XV has been inserted at the +// beginning of the array. +// +// Input/output, double YD[ND], the divided difference coefficients +// corresponding to the XD array. On output, this array has been +// adjusted. +// +// Input, double XV, a new X value which is to be used in the representation +// of the polynomial. On output, XD[0] equals XV and the representation +// of the polynomial has been suitably changed. +// Note that XV does not have to be distinct from any of the original XD +// values. +// +{ + int i; +// +// Recompute the divided difference coefficients. +// + for ( i = nd - 2; 0 <= i; i-- ) + { + yd[i] = yd[i] + ( xv - xd[i] ) * yd[i+1]; + } +// +// Shift the X values up one position and insert XV. +// + for ( i = nd - 1; 0 < i; i-- ) + { + xd[i] = xd[i-1]; + } + + xd[0] = xv; + + return; +} +//****************************************************************************80 + +void dif_shift_zero ( int nd, double xd[], double yd[] ) + +//****************************************************************************80 +// +// Purpose: +// +// DIF_SHIFT_ZERO shifts a divided difference table so that all abscissas are zero. +// +// Discussion: +// +// When the abscissas are changed, the coefficients naturally +// must also be changed. +// +// The resulting pair (XD, YD) still represents the +// same polynomial, but the entries in YD are now the +// standard polynomial coefficients. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 June 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Carl deBoor, +// A Practical Guide to Splines, +// Springer, 2001, +// ISBN: 0387953663, +// LC: QA1.A647.v27. +// +// Parameters: +// +// Input, int ND, the length of the XD and YD arrays. +// +// Input/output, double XD[ND], the X values that correspond to the +// divided difference table. On output, XD contains only zeroes. +// +// Input/output, double YD[ND], the divided difference table +// for the polynomial. On output, YD is also +// the coefficient array for the standard representation +// of the polynomial. +// +{ + int i; + double xv; + + xv = 0.0; + + for ( i = 1; i <= nd; i++ ) + { + webbur::dif_shift_x ( nd, xd, yd, xv ); + } + + return; +} +//****************************************************************************80 + +void dif_to_r8poly ( int nd, double xd[], double yd[], double c[] ) + +//****************************************************************************80 +// +// Purpose: +// +// DIF_TO_R8POLY converts a divided difference table to a standard polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 21 February 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Carl deBoor, +// A Practical Guide to Splines, +// Springer, 2001, +// ISBN: 0387953663, +// LC: QA1.A647.v27. +// +// Parameters: +// +// Input, int ND, the number of coefficients, and abscissas. +// +// Input, double XD[ND], the X values used in the divided difference +// representation of the polynomial. +// +// Input, double YD[ND], the divided difference table. +// +// Output, double C[ND], the standard form polyomial coefficients. +// C[0] is the constant term, and C[ND-1] is the coefficient +// of X^(ND-1). +// +{ + int i; + int j; + + for ( i = 0; i < nd; i++ ) + { + c[i] = yd[i]; + } +// +// Recompute the divided difference coefficients. +// + for ( j = 1; j <= nd - 1; j++ ) + { + for ( i = 1; i <= nd - j; i++ ) + { + c[nd-i-1] = c[nd-i-1] - xd[nd-i-j] * c[nd-i]; + } + } + + return; +} +//****************************************************************************80 + +void fejer2_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// FEJER2_COMPUTE computes a Fejer type 2 rule. +// +// Discussion: +// +// Our convention is that the abscissas are numbered from left to right. +// +// The rule is defined on [-1,1]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + int i; + int j; + double p; + double pi = 3.141592653589793; + double theta; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "FEJER2_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::exit ( 1 ); + } + else if ( n == 1 ) + { + x[0] = 0.0; + w[0] = 2.0; + return; + } + + for ( i = 0; i < n; i++ ) + { + x[i] = std::cos ( ( double ) ( n - i ) * pi + / ( double ) ( n + 1 ) ); + } + if ( ( n % 2 ) == 1 ) + { + x[(n-1)/2] = 0.0; + } + + if ( n == 2 ) + { + w[0] = 1.0; + w[1] = 1.0; + } + else + { + for ( i = 0; i < n; i++ ) + { + theta = ( double ) ( n - i ) * pi + / ( double ) ( n + 1 ); + + w[i] = 1.0; + + for ( j = 1; j <= ( ( n - 1 ) / 2 ); j++ ) + { + w[i] = w[i] - 2.0 * std::cos ( 2.0 * ( double ) ( j ) * theta ) + / ( double ) ( 4 * j * j - 1 ); + } + p = 2.0 * ( double ) ( ( ( n + 1 ) / 2 ) ) - 1.0; + w[i] = w[i] - std::cos ( ( p + 1.0 ) * theta ) / p; + } + for ( i = 0; i < n; i++ ) + { + w[i] = 2.0 * w[i] / ( double ) ( n + 1 ); + } + } + return; +} +//****************************************************************************80 + +void fejer2_compute_np ( int n, int np, double p[], double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// FEJER2_COMPUTE_NP computes a Fejer type 2 rule. +// +// Discussion: +// +// Our convention is that the abscissas are numbered from left to right. +// +// The rule is defined on [-1,1]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::fejer2_compute ( n, x, w ); + + return; +} +//****************************************************************************80 + +void fejer2_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// FEJER2_COMPUTE_POINTS computes Fejer type 2 quadrature points. +// +// Discussion: +// +// Our convention is that the abscissas are numbered from left to right. +// +// The rule is defined on [-1,1]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +{ + int i; + double pi = 3.141592653589793; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "FEJER2_COMPUTE_POINTS - Fatal error!\n"; + std::cerr << " N < 1.\n"; + std::exit ( 1 ); + } + else if ( n == 1 ) + { + x[0] = 0.0; + } + else + { + for ( i = 1; i <= n; i++ ) + { + x[i-1] = std::cos ( ( double ) ( n + 1 - i ) * pi + / ( double ) ( n + 1 ) ); + } + if ( ( n % 2 ) == 1 ) + { + x[(n-1)/2] = 0.0; + } + } + return; +} +//****************************************************************************80 + +void fejer2_compute_points_np ( int n, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// FEJER2_COMPUTE_POINTS_NP computes Fejer type 2 quadrature points. +// +// Discussion: +// +// Our convention is that the abscissas are numbered from left to right. +// +// The rule is defined on [-1,1]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + webbur::fejer2_compute_points ( n, x ); + + return; +} +//****************************************************************************80 + +void fejer2_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// FEJER2_COMPUTE_WEIGHTS computes Fejer type 2 quadrature weights. +// +// Discussion: +// +// The user must preallocate space for the output array W. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Walter Gautschi, +// Numerical Quadrature in the Presence of a Singularity, +// SIAM Journal on Numerical Analysis, +// Volume 4, Number 3, 1967, pages 357-362. +// +// Joerg Waldvogel, +// Fast Construction of the Fejer and Clenshaw-Curtis Quadrature Rules, +// BIT Numerical Mathematics, +// Volume 43, Number 1, 2003, pages 1-18. +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double W[N], the weights. +// +{ + int i; + int j; + double p; + double pi = 3.141592653589793; + double theta; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "FEJER2_COMPUTE_WEIGHTS - Fatal error!\n"; + std::cerr << " N < 1.\n"; + std::exit ( 1 ); + } + else if ( n == 1 ) + { + w[0] = 2.0; + } + else if ( n == 2 ) + { + w[0] = 1.0; + w[1] = 1.0; + } + else + { + for ( i = 1; i <= n; i++ ) + { + theta = ( double ) ( n + 1 - i ) * pi + / ( double ) ( n + 1 ); + + w[i-1] = 1.0; + + for ( j = 1; j <= ( ( n - 1 ) / 2 ); j++ ) + { + w[i-1] = w[i-1] - 2.0 * std::cos ( 2.0 * ( double ) ( j ) * theta ) + / ( double ) ( 4 * j * j - 1 ); + } + p = 2.0 * ( double ) ( ( ( n + 1 ) / 2 ) ) - 1.0; + w[i-1] = w[i-1] - std::cos ( ( p + 1.0 ) * theta ) / p; + } + for ( i = 0; i < n; i++ ) + { + w[i] = 2.0 * w[i] / ( double ) ( n + 1 ); + } + } + return; +} +//****************************************************************************80 + +void fejer2_compute_weights_np ( int n, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// FEJER2_COMPUTE_WEIGHTS_NP computes Fejer type 2 quadrature weights. +// +// Discussion: +// +// The user must preallocate space for the output array W. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Walter Gautschi, +// Numerical Quadrature in the Presence of a Singularity, +// SIAM Journal on Numerical Analysis, +// Volume 4, Number 3, 1967, pages 357-362. +// +// Joerg Waldvogel, +// Fast Construction of the Fejer and Clenshaw-Curtis Quadrature Rules, +// BIT Numerical Mathematics, +// Volume 43, Number 1, 2003, pages 1-18. +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + webbur::fejer2_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void gegenbauer_compute ( int order, double alpha, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEGENBAUER_COMPUTE computes a Gegenbauer quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) (1-X^2)^ALPHA * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// Thanks to Janiki Raman for pointing out a problem in an earlier +// version of the code that occurred when ALPHA was -0.5. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, double ALPHA, the exponent of (1-X^2). -1.0 < ALPHA is required. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double an; + double *c; + double cc; + double delta; + double dp2; + int i; + double p1; + double prod; + double r1; + double r2; + double r3; + double temp; + double x0; +// +// Check ORDER. +// + if ( order < 1 ) + { + std::cerr << "\n"; + std::cerr << "GEGENBAUER_COMPUTE - Fatal error!\n"; + std::cerr << " 1 <= ORDER is required.\n"; + std::exit ( 1 ); + } + c = new double[order]; +// +// Check ALPHA. +// + if ( alpha <= -1.0 ) + { + std::cerr << "\n"; + std::cerr << "GEGENBAUER_COMPUTE - Fatal error!\n"; + std::cerr << " -1.0 < ALPHA is required.\n"; + std::exit ( 1 ); + } +// +// Set the recursion coefficients. +// + c[0] = 0.0; + if ( 2 <= order ) + { + c[1] = 1.0 / ( 2.0 * alpha + 3.0 ); + } + + for ( i = 3; i <= order; i++ ) + { + c[i-1] = ( double ) ( i - 1 ) + * ( alpha + alpha + ( double ) ( i - 1 ) ) / + ( ( alpha + alpha + ( double ) ( 2 * i - 1 ) ) + * ( alpha + alpha + ( double ) ( 2 * i - 3 ) ) ); + } + + delta = webbur::r8_gamma ( alpha + 1.0 ) + * webbur::r8_gamma ( alpha + 1.0 ) + / webbur::r8_gamma ( alpha + alpha + 2.0 ); + + prod = 1.0; + for ( i = 2; i <= order; i++ ) + { + prod = prod * c[i-1]; + } + cc = delta * std::pow ( 2.0, alpha + alpha + 1.0 ) * prod; + + for ( i = 1; i <= order; i++ ) + { + if ( i == 1 ) + { + an = alpha / ( double ) ( order ); + + r1 = ( 1.0 + alpha ) + * ( 2.78 / ( 4.0 + ( double ) ( order * order ) ) + + 0.768 * an / ( double ) ( order ) ); + + r2 = 1.0 + 2.44 * an + 1.282 * an * an; + + x0 = ( r2 - r1 ) / r2; + } + else if ( i == 2 ) + { + r1 = ( 4.1 + alpha ) / + ( ( 1.0 + alpha ) * ( 1.0 + 0.156 * alpha ) ); + + r2 = 1.0 + 0.06 * ( ( double ) ( order ) - 8.0 ) * + ( 1.0 + 0.12 * alpha ) / ( double ) ( order ); + + r3 = 1.0 + 0.012 * alpha * + ( 1.0 + 0.25 * r8_abs ( alpha ) ) / ( double ) ( order ); + + x0 = x0 - r1 * r2 * r3 * ( 1.0 - x0 ); + } + else if ( i == 3 ) + { + r1 = ( 1.67 + 0.28 * alpha ) / ( 1.0 + 0.37 * alpha ); + + r2 = 1.0 + 0.22 * ( ( double ) ( order ) - 8.0 ) + / ( double ) ( order ); + + r3 = 1.0 + 8.0 * alpha / + ( ( 6.28 + alpha ) * ( double ) ( order * order ) ); + + x0 = x0 - r1 * r2 * r3 * ( x[0] - x0 ); + } + else if ( i < order - 1 ) + { + x0 = 3.0 * x[i-2] - 3.0 * x[i-3] + x[i-4]; + } + else if ( i == order - 1 ) + { + r1 = ( 1.0 + 0.235 * alpha ) / ( 0.766 + 0.119 * alpha ); + + r2 = 1.0 / ( 1.0 + 0.639 + * ( ( double ) ( order ) - 4.0 ) + / ( 1.0 + 0.71 * ( ( double ) ( order ) - 4.0 ) ) ); + + r3 = 1.0 / ( 1.0 + 20.0 * alpha / ( ( 7.5 + alpha ) * + ( double ) ( order * order ) ) ); + + x0 = x0 + r1 * r2 * r3 * ( x0 - x[i-3] ); + } + else if ( i == order ) + { + r1 = ( 1.0 + 0.37 * alpha ) / ( 1.67 + 0.28 * alpha ); + + r2 = 1.0 / + ( 1.0 + 0.22 * ( ( double ) ( order ) - 8.0 ) + / ( double ) ( order ) ); + + r3 = 1.0 / ( 1.0 + 8.0 * alpha / + ( ( 6.28 + alpha ) * ( double ) ( order * order ) ) ); + + x0 = x0 + r1 * r2 * r3 * ( x0 - x[i-3] ); + } + + webbur::gegenbauer_root ( &x0, order, alpha, &dp2, &p1, c ); + + x[i-1] = x0; + w[i-1] = cc / ( dp2 * p1 ); + } +// +// Reverse the order of the values. +// + for ( i = 1; i <= order/2; i++ ) + { + temp = x[i-1]; + x[i-1] = x[order-i]; + x[order-i] = temp; + } + + for ( i = 1; i <=order/2; i++ ) + { + temp = w[i-1]; + w[i-1] = w[order-i]; + w[order-i] = temp; + } + + delete [] c; + + return; +} +//****************************************************************************80 + +void gegenbauer_compute_np ( int order, int np, double p[], double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEGENBAUER_COMPUTE_NP computes a Gegenbauer quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) (1-X^2)^ALPHA * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// Thanks to Janiki Raman for pointing out a problem in an earlier +// version of the code that occurred when ALPHA was -0.5. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], contains parameters. +// P[0] = ALPHA = the exponent of (1-X^2). -1.0 < ALPHA is required. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double alpha; + + alpha = p[0]; + + webbur::gegenbauer_compute ( order, alpha, x, w ); + + return; +} +//****************************************************************************80 + +void gegenbauer_compute_points ( int order, double alpha, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEGENBAUER_COMPUTE_POINTS computes Gegenbauer quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, double ALPHA, the exponent of (1-X^2). -1.0 < ALPHA is required. +// +// Output, double X[ORDER], the abscissas. +// +{ + double *w; + + w = new double[order]; + + webbur::gegenbauer_compute ( order, alpha, x, w ); + + delete [] w; + + return; +} +//****************************************************************************80 + +void gegenbauer_compute_points_np ( int order, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEGENBAUER_COMPUTE_POINTS_NP computes Gegenbauer quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], contains parameters. +// P[0] = ALPHA = the exponent of (1-X^2). -1.0 < ALPHA is required. +// +// Output, double X[ORDER], the abscissas. +// +{ + double alpha; + + alpha = p[0]; + + webbur::gegenbauer_compute_points ( order, alpha, x ); + + return; +} +//****************************************************************************80 + +void gegenbauer_compute_weights ( int order, double alpha, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEGENBAUER_COMPUTE_WEIGHTS computes Gegenbauer quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, double ALPHA, the exponent of (1-X^2). -1.0 < ALPHA is required. +// +// Output, double W[ORDER], the weights. +// +{ + double *x; + + x = new double[order]; + + webbur::gegenbauer_compute ( order, alpha, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void gegenbauer_compute_weights_np ( int order, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEGENBAUER_COMPUTE_WEIGHTS_NP computes Gegenbauer quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, double P[1], contains parameters. +// P[0] = ALPHA = the exponent of (1-X^2). -1.0 < ALPHA is required. +// +// Output, double W[ORDER], the weights. +// +{ + double alpha; + + alpha = p[0]; + + webbur::gegenbauer_compute_weights ( order, alpha, w ); + + return; +} +//****************************************************************************80 + +double gegenbauer_integral ( int expon, double alpha ) + +//****************************************************************************80 +// +// Purpose: +// +// GEGENBAUER_INTEGRAL integrates a monomial with Gegenbauer weight. +// +// Discussion: +// +// VALUE = Integral ( -1 <= X <= +1 ) x^EXPON (1-x^2)^ALPHA dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 26 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int EXPON, the exponent. +// +// Input, double ALPHA, the exponent of (1-X^2) in the weight factor. +// +// Output, double GEGENBAUER_INTEGRAL, the value of the integral. +// +{ + double arg1; + double arg2; + double arg3; + double arg4; + double c; + double value; + double value1; + + if ( ( expon % 2 ) == 1 ) + { + value = 0.0; + return value; + } + + c = ( double ) ( expon ); + + arg1 = - alpha; + arg2 = 1.0 + c; + arg3 = 2.0 + alpha + c; + arg4 = - 1.0; + + value1 = webbur::r8_hyper_2f1 ( arg1, arg2, arg3, arg4 ); + + value = webbur::r8_gamma ( 1.0 + c ) * 2.0 + * webbur::r8_gamma ( 1.0 + alpha ) * value1 + / webbur::r8_gamma ( 2.0 + alpha + c ); + + return value; +} +//****************************************************************************80 + +void gegenbauer_recur ( double *p2, double *dp2, double *p1, double x, + int order, double alpha, double c[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEGENBAUER_RECUR evaluates a Gegenbauer polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 26 February 2008 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Output, double *P2, the value of J(ORDER)(X). +// +// Output, double *DP2, the value of J'(ORDER)(X). +// +// Output, double *P1, the value of J(ORDER-1)(X). +// +// Input, double X, the point at which polynomials are evaluated. +// +// Input, int ORDER, the order of the polynomial. +// +// Input, double ALPHA, the exponents of (1-X^2). +// +// Input, double C[ORDER], the recursion coefficients. +// +{ + double dp0; + double dp1; + int i; + double p0; + + *p1 = 1.0; + dp1 = 0.0; + + *p2 = x; + *dp2 = 1.0; + + for ( i = 2; i <= order; i++ ) + { + p0 = *p1; + dp0 = dp1; + + *p1 = *p2; + dp1 = *dp2; + + *p2 = x * ( *p1 ) - c[i-1] * p0; + *dp2 = x * dp1 + ( *p1 ) - c[i-1] * dp0; + } + return; +} +//****************************************************************************80 + +void gegenbauer_root ( double *x, int order, double alpha, double *dp2, + double *p1, double c[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEGENBAUER_ROOT improves an approximate root of a Gegenbauer polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 26 February 2008 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input/output, double *X, the approximate root, which +// should be improved on output. +// +// Input, int ORDER, the order of the polynomial. +// +// Input, double ALPHA, the exponents of (1-X^2). +// +// Output, double *DP2, the value of J'(ORDER)(X). +// +// Output, double *P1, the value of J(ORDER-1)(X). +// +// Input, double C[ORDER], the recursion coefficients. +// +{ + double d; + double eps; + double p2; + int step; + int step_max = 10; + + eps = webbur::r8_epsilon ( ); + + for ( step = 1; step <= step_max; step++ ) + { + webbur::gegenbauer_recur ( &p2, dp2, p1, *x, order, alpha, c ); + + d = p2 / ( *dp2 ); + *x = *x - d; + + if ( webbur::r8_abs ( d ) <= eps * ( webbur::r8_abs ( *x ) + 1.0 ) ) + { + return; + } + } + return; +} +//****************************************************************************80 + +void gen_hermite_compute ( int n, double alpha, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_HERMITE_COMPUTE computes a generalized Gauss-Hermite quadrature rule. +// +// Discussion: +// +// The code uses an algorithm by Elhay and Kautsky. +// +// The integral: +// +// integral ( -oo < x < +oo ) |x|^alpha exp(-x^2) f(x) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 30 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky. +// C++ version by John Burkardt. +// +// Reference: +// +// Sylvan Elhay, Jaroslav Kautsky, +// Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of +// Interpolatory Quadrature, +// ACM Transactions on Mathematical Software, +// Volume 13, Number 4, December 1987, pages 399-415. +// +// Parameters: +// +// Input, int N, the number of abscissas. +// +// Input, double ALPHA, the parameter. +// -1.0 < ALPHA. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double *bj; + int i; + double i_r8; + double zemu; +// +// Define the zero-th moment. +// + zemu = webbur::r8_gamma ( ( alpha + 1.0 ) / 2.0 ); +// +// Define the Jacobi matrix. +// + bj = new double[n]; + + for ( i = 0; i < n; i++ ) + { + i_r8 = ( double ) ( i + 1 ); + if ( ( i % 2 ) == 0 ) + { + bj[i] = ( i_r8 + alpha ) / 2.0; + } + else + { + bj[i] = i_r8 / 2.0; + } + } + + for ( i = 0; i < n; i++ ) + { + bj[i] = std::sqrt ( bj[i] ); + } + + for ( i = 0; i < n; i++ ) + { + x[i] = 0.0; + } + + w[0] = std::sqrt ( zemu ); + for ( i = 1; i < n; i++ ) + { + w[i] = 0.0; + } +// +// Diagonalize the Jacobi matrix. +// + webbur::imtqlx ( n, x, bj, w ); + + for ( i = 0; i < n; i++ ) + { + w[i] = w[i] * w[i]; + } + + delete [] bj; + + return; +} +//****************************************************************************80 + +void gen_hermite_compute_np ( int order, int np, double p[], double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_HERMITE_COMPUTE_NP computes a Generalized Hermite quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -oo < x < +oo ) |x|^ALPHA exp(-x^2) f(x) dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], contains parameters. +// P[0] = ALPHA, the exponent of the X factor. -1.0 < ALPHA. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double alpha; + + alpha = p[0]; + + webbur::gen_hermite_compute ( order, alpha, x, w ); + + return; +} +//****************************************************************************80 + +void gen_hermite_compute_points ( int order, double alpha, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_HERMITE_COMPUTE_POINTS computes Generalized Hermite quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, double ALPHA, the exponent of the X factor. +// -1.0 < ALPHA. +// +// Output, double X[ORDER], the abscissas. +// +{ + double *w; + + w = new double[order]; + + webbur::gen_hermite_compute ( order, alpha, x, w ); + + delete [] w; + + return; +} +//****************************************************************************80 + +void gen_hermite_compute_points_np ( int order, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_HERMITE_COMPUTE_POINTS_NP: Generalized Hermite quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], contains parameters. +// P[0] = ALPHA, the exponent of the X factor. -1.0 < ALPHA. +// +// Output, double X[ORDER], the abscissas. +// +{ + double alpha; + + alpha = p[0]; + + webbur::gen_hermite_compute_points ( order, alpha, x ); + + return; +} +//****************************************************************************80 + +void gen_hermite_compute_weights ( int order, double alpha, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_HERMITE_COMPUTE_WEIGHTS computes Generalized Hermite quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, double ALPHA, the exponent of the X factor. +// -1.0 < ALPHA. +// +// Output, double W[ORDER], the weights. +// +{ + double *x; + + x = new double[order]; + + webbur::gen_hermite_compute ( order, alpha, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void gen_hermite_compute_weights_np ( int order, int np, double p[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_HERMITE_COMPUTE_WEIGHTS_NP: Generalized Hermite quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], contains parameters. +// P[0] = ALPHA, the exponent of the X factor. -1.0 < ALPHA. +// +// Output, double W[ORDER], the weights. +// +{ + double alpha; + + alpha = p[0]; + + webbur::gen_hermite_compute_weights ( order, alpha, w ); + + return; +} +//****************************************************************************80 + +void gen_hermite_dr_compute ( int order, double alpha, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_HERMITE_DR_COMPUTE computes a Generalized Hermite quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -oo < x < +oo ) |x|^ALPHA exp(-x^2) f(x) dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, double ALPHA, the exponent of the X factor. +// -1.0 < ALPHA. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double alpha_laguerre; + double arg; + int i; + int order_laguerre; + double *w_laguerre; + double *x_laguerre; + + if ( order < 1 ) + { + std::cerr << "\n"; + std::cerr << "GEN_HERMITE_DR_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of ORDER = " << order << "\n"; + std::exit ( 1 ); + } + + if ( order == 1 ) + { + arg = ( alpha + 1.0 ) / 2.0; + x[0] = 0.0; + w[0] = webbur::r8_gamma ( arg ); + return; + } + + if ( ( order % 2 ) == 0 ) + { + order_laguerre = order / 2; + alpha_laguerre = ( alpha - 1.0 ) / 2.0; + } + else + { + order_laguerre = ( order - 1 ) / 2; + alpha_laguerre = ( alpha + 1.0 ) / 2.0; + } + + w_laguerre = new double[order_laguerre]; + x_laguerre = new double[order_laguerre]; + + webbur::gen_laguerre_ss_compute ( order_laguerre, alpha_laguerre, x_laguerre, + w_laguerre ); + + if ( ( order % 2 ) == 0 ) + { + for ( i = 0; i < order_laguerre; i++ ) + { + x[i] = - std::sqrt ( x_laguerre[order_laguerre-1-i] ); + } + for ( i = 0; i < order_laguerre; i++ ) + { + x[order_laguerre+i] = std::sqrt ( x_laguerre[i] ); + } + for ( i = 0; i < order_laguerre; i++ ) + { + w[i] = 0.5 * w_laguerre[order_laguerre-1-i]; + } + for ( i = 0; i < order_laguerre; i++ ) + { + w[order_laguerre+i] = 0.5 * w_laguerre[i]; + } + } + else if ( ( order % 2 ) == 1 ) + { + for ( i = 0; i < order_laguerre; i++ ) + { + x[i] = - std::sqrt ( x_laguerre[order_laguerre-1-i] ); + } + x[order_laguerre] = 0.0; + for ( i = 0; i < order_laguerre; i++ ) + { + x[order_laguerre+1+i] = std::sqrt ( x_laguerre[i] ); + } + for ( i = 0; i < order_laguerre; i++ ) + { + w[i] = 0.5 * w_laguerre[order_laguerre-1-i] / x_laguerre[order_laguerre-1-i]; + } + + arg = ( alpha + 1.0 ) / 2.0; + w[order_laguerre] = webbur::r8_gamma ( arg ); + for ( i = 0; i < order_laguerre; i++ ) + { + w[order_laguerre] = w[order_laguerre] - w_laguerre[i] / x_laguerre[i]; + } + + for ( i = 0; i < order_laguerre; i++ ) + { + w[order_laguerre+1+i] = 0.5 * w_laguerre[i] / x_laguerre[i]; + } + } + delete [] w_laguerre; + delete [] x_laguerre; + + return; +} +//****************************************************************************80 + +double gen_hermite_integral ( int expon, double alpha ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_HERMITE_INTEGRAL evaluates a monomial Generalized Hermite integral. +// +// Discussion: +// +// H(n,alpha) = Integral ( -oo < x < +oo ) x^n |x|^alpha exp(-x^2) dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int EXPON, the exponent of the monomial. +// 0 <= EXPON. +// +// Input, double ALPHA, the exponent of |X| in the weight function. +// -1.0 < ALPHA. +// +// Output, double GEN_HERMITE_INTEGRAL, the value of the integral. +// +{ + double a; + double arg; + double value; + + if ( ( expon % 2 ) == 1 ) + { + value = 0.0; + } + else + { + a = alpha + ( double ) ( expon ); + if ( a <= - 1.0 ) + { + value = - webbur::r8_huge ( ); + } + else + { + arg = ( a + 1.0 ) / 2.0; + value = webbur::r8_gamma ( arg ); + } + } + return value; +} +//****************************************************************************80 + +void gen_laguerre_compute ( int n, double alpha, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_COMPUTE: generalized Gauss-Laguerre quadrature rule. +// +// Discussion: +// +// The integral: +// +// integral ( 0 <= x < +oo ) exp ( - x ) * x^alpha * f(x) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// The integral: +// +// integral ( 0 <= x < +oo ) x^alpha * f(x) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * exp ( x(i) ) * f ( x(i) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky. +// C++ version by John Burkardt. +// +// Reference: +// +// Sylvan Elhay, Jaroslav Kautsky, +// Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of +// Interpolatory Quadrature, +// ACM Transactions on Mathematical Software, +// Volume 13, Number 4, December 1987, pages 399-415. +// +// Parameters: +// +// Input, int N, the order. +// +// Input, double ALPHA, the exponent of the X factor. +// ALPHA must be nonnegative. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double *bj; + int i; + double i_r8; + double zemu; +// +// Define the zero-th moment. +// + zemu = webbur::r8_gamma ( alpha + 1.0 ); +// +// Define the Jacobi matrix. +// + bj = new double[n]; + + for ( i = 0; i < n; i++ ) + { + i_r8 = ( double ) ( i + 1 ); + bj[i] = std::sqrt ( i_r8 * ( i_r8 + alpha ) ); + } + + for ( i = 0; i < n; i++ ) + { + i_r8 = ( double ) ( i + 1 ); + x[i] = 2.0 * i_r8 - 1.0 + alpha; + } + + w[0] = std::sqrt ( zemu ); + + for ( i = 1; i < n; i++ ) + { + w[i] = 0.0; + } +// +// Diagonalize the Jacobi matrix. +// + imtqlx ( n, x, bj, w ); + + for ( i = 0; i < n; i++ ) + { + w[i] = w[i] * w[i]; + } + + delete [] bj; + + return; +} +//****************************************************************************80 + +void gen_laguerre_compute_np ( int order, int np, double p[], double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_COMPUTE_NP computes a Generalized Laguerre quadrature rule. +// +// Discussion: +// +// In the simplest case, ALPHA is 0, and we are approximating the +// integral from 0 to +oo of exp(-X) * F(X). When this is so, +// it is easy to modify the rule to approximate the integral from +// A to +oo as well. +// +// If ALPHA is nonzero, then there is no simple way to extend the +// rule to approximate the integral from A to +oo. The simplest +// procedures would be to approximate the integral from 0 to A. +// +// If the integral to approximate is: +// +// Integral ( A <= X < +oo ) exp ( - X ) * F(X) dX +// or +// Integral ( 0 <= X < +oo ) exp ( - X ) * X^ALPHA * F(X) dX +// +// then the quadrature rule is: +// +// exp ( - A ) * Sum ( 1 <= I <= ORDER ) W(I) * F ( A+X(I) ) +// or +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// +// If the integral to approximate is: +// +// Integral ( A <= X < +oo ) F(X) dX +// or +// Integral ( 0 <= X < +oo ) X^ALPHA * F(X) dX +// +// then the quadrature rule is: +// +// exp ( - A ) * Sum ( 1 <= I <= ORDER ) +// W(I) * exp(A+X(I)) * F ( A+X(I) ) +// or +// Sum ( 1 <= I <= ORDER ) W(I) * exp(X(I)) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, double P[1], contains parameters. +// P[0] = ALPHA, the exponent of the X factor. +// Set ALPHA = 0.0 for the simplest rule. +// ALPHA must be nonnegative. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double alpha; + + alpha = p[0]; + + webbur::gen_laguerre_compute ( order, alpha, x, w ); + + return; +} +//****************************************************************************80 + +void gen_laguerre_compute_points ( int order, double alpha, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_COMPUTE_POINTS: Generalized Laguerre quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 March 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, double ALPHA, the exponent of the X factor. +// Set ALPHA = 0.0 for the simplest rule. +// ALPHA must be nonnegative. +// +// Output, double X[ORDER], the abscissas. +// +{ + double *w; + + w = new double[order]; + + webbur::gen_laguerre_compute ( order, alpha, x, w ); + + delete [] w; + + return; +} +//****************************************************************************80 + +void gen_laguerre_compute_points_np ( int order, int np, double p[], + double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_COMPUTE_POINTS_NP: Generalized Laguerre quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], contains parameters. +// P[0] = ALPHA, the exponent of the X factor. +// Set ALPHA = 0.0 for the simplest rule. +// ALPHA must be nonnegative. +// +// Output, double X[ORDER], the abscissas. +// +{ + double alpha; + + alpha = p[0]; + + webbur::gen_laguerre_compute_points ( order, alpha, x ); + + return; +} +//****************************************************************************80 + +void gen_laguerre_compute_weights ( int order, double alpha, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_COMPUTE_WEIGHTS: Generalized Laguerre quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, double ALPHA, the exponent of the X factor. +// Set ALPHA = 0.0 for the simplest rule. +// ALPHA must be nonnegative. +// +// Output, double W[ORDER], the weights. +// +{ + double *x; + + x = new double[order]; + + webbur::gen_laguerre_compute ( order, alpha, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void gen_laguerre_compute_weights_np ( int order, int np, double p[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_COMPUTE_WEIGHTS_NP: Generalized Laguerre quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], contains parameters. +// P[0] = ALPHA, the exponent of the X factor. +// Set ALPHA = 0.0 for the simplest rule. +// ALPHA must be nonnegative. +// +// Output, double W[ORDER], the weights. +// +{ + double alpha; + + alpha = p[0]; + + webbur::gen_laguerre_compute_weights ( order, alpha, w ); + + return; +} +//****************************************************************************80 + +double gen_laguerre_integral ( int expon, double alpha ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_INTEGRAL evaluates a monomial Generalized Laguerre integral. +// +// Discussion: +// +// L(n,alpha) = Integral ( 0 <= x < +oo ) x^n * x^alpha exp(-x) dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 20 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int EXPON, the exponent of the monomial. +// 0 <= EXPON. +// +// Input, double ALPHA, the exponent of X in the weight function. +// -1.0 < ALPHA. +// +// Output, double GEN_LAGUERRE_INTEGRAL, the value of the integral. +// +{ + double arg; + double value; + + arg = alpha + ( double ) ( expon + 1.0 ); + value = webbur::r8_gamma ( arg ); + + return value; +} +//****************************************************************************80 + +void gen_laguerre_ss_compute ( int order, double alpha, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_SS_COMPUTE computes a Generalized Laguerre quadrature rule. +// +// Discussion: +// +// In the simplest case, ALPHA is 0, and we are approximating the +// integral from 0 to +oo of exp(-X) * F(X). When this is so, +// it is easy to modify the rule to approximate the integral from +// A to +oo as well. +// +// If ALPHA is nonzero, then there is no simple way to extend the +// rule to approximate the integral from A to +oo. The simplest +// procedures would be to approximate the integral from 0 to A. +// +// If the integral to approximate is: +// +// Integral ( A <= X < +oo ) exp ( - X ) * F(X) dX +// or +// Integral ( 0 <= X < +oo ) exp ( - X ) * X^ALPHA * F(X) dX +// +// then the quadrature rule is: +// +// exp ( - A ) * Sum ( 1 <= I <= ORDER ) W(I) * F ( A+X(I) ) +// or +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// +// If the integral to approximate is: +// +// Integral ( A <= X < +oo ) F(X) dX +// or +// Integral ( 0 <= X < +oo ) X^ALPHA * F(X) dX +// +// then the quadrature rule is: +// +// exp ( - A ) * Sum ( 1 <= I <= ORDER ) +// W(I) * exp(A+X(I)) * F ( A+X(I) ) +// or +// Sum ( 1 <= I <= ORDER ) W(I) * exp(X(I)) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, double ALPHA, the exponent of the X factor. +// Set ALPHA = 0.0 for the simplest rule. +// ALPHA must be nonnegative. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double *b; + double *c; + double cc; + double dp2; + int i; + double p1; + double prod; + double r1; + double r2; + double ratio; + double x0; + + if ( order < 1 ) + { + std::cerr << "\n"; + std::cerr << "GEN_LAGUERRE_SS_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of ORDER = " << order << "\n"; + std::exit ( 1 ); + } + + b = new double[order]; + c = new double[order]; +// +// Set the recursion coefficients. +// + for ( i = 0; i < order; i++ ) + { + b[i] = ( alpha + ( double ) ( 2 * i + 1 ) ); + } + + for ( i = 0; i < order; i++ ) + { + c[i] = ( double ) ( i ) * ( alpha + ( double ) ( i ) ); + } + prod = 1.0; + for ( i = 1; i < order; i++ ) + { + prod = prod * c[i]; + } + cc = webbur::r8_gamma ( alpha + 1.0 ) * prod; + + for ( i = 0; i < order; i++ ) + { +// +// Compute an estimate for the root. +// + if ( i == 0 ) + { + x0 = ( 1.0 + alpha ) * ( 3.0+ 0.92 * alpha ) / + ( 1.0 + 2.4 * ( double ) ( order ) + 1.8 * alpha ); + } + else if ( i == 1 ) + { + x0 = x0 + ( 15.0 + 6.25 * alpha ) / + ( 1.0 + 0.9 * alpha + 2.5 * ( double ) ( order ) ); + } + else + { + r1 = ( 1.0 + 2.55 * ( double ) ( i - 1 ) ) + / ( 1.9 * ( double ) ( i - 1 ) ); + + r2 = 1.26 * ( double ) ( i - 1 ) * alpha / + ( 1.0 + 3.5 * ( double ) ( i - 1 ) ); + + ratio = ( r1 + r2 ) / ( 1.0 + 0.3 * alpha ); + + x0 = x0 + ratio * ( x0 - x[i-2] ); + } +// +// Use iteration to find the root. +// + webbur::gen_laguerre_ss_root ( &x0, order, alpha, &dp2, &p1, b, c ); +// +// Set the abscissa and weight. +// + x[i] = x0; + w[i] = ( cc / dp2 ) / p1; + } + + delete [] b; + delete [] c; + + return; +} +//****************************************************************************80 + +void gen_laguerre_ss_recur ( double *p2, double *dp2, double *p1, double x, + int order, double alpha, double b[], double c[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_SS_RECUR evaluates a Generalized Laguerre polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 February 2008 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Output, double *P2, the value of L(ORDER)(X). +// +// Output, double *DP2, the value of L'(ORDER)(X). +// +// Output, double *P1, the value of L(ORDER-1)(X). +// +// Input, double X, the point at which polynomials are evaluated. +// +// Input, int ORDER, the order of the polynomial. +// +// Input, double ALPHA, the exponent of the X factor in the +// integrand. +// +// Input, double B[ORDER], C[ORDER], the recursion coefficients. +// +{ + double dp0; + double dp1; + int i; + double p0; + + *p1 = 1.0; + dp1 = 0.0; + + *p2 = x - alpha - 1.0; + *dp2 = 1.0; + + for ( i = 1; i < order; i++ ) + { + p0 = *p1; + dp0 = dp1; + + *p1 = *p2; + dp1 = *dp2; + + *p2 = ( x - b[i] ) * ( *p1 ) - c[i] * p0; + *dp2 = ( x - b[i] ) * dp1 + ( *p1 ) - c[i] * dp0; + } + + return; +} +//****************************************************************************80 + +void gen_laguerre_ss_root ( double *x, int order, double alpha, double *dp2, + double *p1, double b[], double c[] ) + +//****************************************************************************80 +// +// Purpose: +// +// GEN_LAGUERRE_SS_ROOT improves a root of a Generalized Laguerre polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 February 2008 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input/output, double *X, the approximate root, which +// should be improved on output. +// +// Input, int ORDER, the order of the polynomial. +// +// Input, double ALPHA, the exponent of the X factor. +// +// Output, double *DP2, the value of L'(ORDER)(X). +// +// Output, double *P1, the value of L(ORDER-1)(X). +// +// Input, double B[ORDER], C[ORDER], the recursion coefficients. +// +{ + double d; + double eps; + double p2; + int step; + int step_max = 10; + + eps = webbur::r8_epsilon ( ); + + for ( step = 1; step <= step_max; step++ ) + { + webbur::gen_laguerre_ss_recur ( &p2, dp2, p1, *x, order, alpha, b, c ); + + d = p2 / ( *dp2 ); + *x = *x - d; + + if ( webbur::r8_abs ( d ) <= eps * ( webbur::r8_abs ( *x ) + 1.0 ) ) + { + break; + } + } + return; +} +//****************************************************************************80 + +void hc_compute_weights_from_points ( int nhalf, double xhalf[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HC_COMPUTE_WEIGHTS_FROM_POINTS: Hermite-Cubic weights, user-supplied points. +// +// Discussion: +// +// An interval [A,B] has been divided by NHALF points X; at each +// point both function and derivative information is available. +// +// The piecewise cubic Hermite interpolant is constructed for this data. +// +// A quadrature rule is determined for the interpolant. +// +// There will be N=2*NHALF weights. If the quadrature rule is to be written +// out, one would normally list each point twice, so that the number of points +// and weights are equal. The listing of the same point value twice is an +// implicit indication that both function and derivative values should be +// used. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 28 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int NHALF, the number of points, not counting repetitions. +// +// Input, double XHALF[NHALF], the points, without repetition. +// +// Output, double W[2*NHALF], the weights. The first two weights are +// associated with the first point, and so on. +// +{ + int j; + + w[0+0*2] = 0.5 * ( xhalf[1] - xhalf[0] ); + w[1+0*2] = std::pow ( xhalf[1] - xhalf[0], 2 ) / 12.0; + + for ( j = 1; j < nhalf - 1; j++ ) + { + w[0+j*2] = 0.5 * ( xhalf[j+1] - xhalf[j-1] ); + w[1+j*2] = ( xhalf[j+1] - xhalf[j-1] ) + * ( xhalf[j+1] - 2.0 * xhalf[j] + xhalf[j-1] ) / 12.0; + } + + w[0+(nhalf-1)*2] = 0.5 * ( xhalf[nhalf-1] - xhalf[nhalf-2] ); + w[1+(nhalf-1)*2] = - std::pow ( xhalf[nhalf-2] - xhalf[nhalf-1], 2 ) / 12.0; + + return; +} +//****************************************************************************80 + +void hcc_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCC_COMPUTE computes a Hermite-Cubic-Chebyshev-Spacing quadrature rule. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into Chebyshev-spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 24 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + int nhalf; + double *xhalf; + + nhalf = n / 2; + xhalf = new double[nhalf]; + + webbur::clenshaw_curtis_compute_points ( nhalf, xhalf ); + webbur::r8vec_stutter ( nhalf, xhalf, 2, x ); + webbur::hc_compute_weights_from_points ( nhalf, xhalf, w ); + + delete [] xhalf; + + return; +} +//****************************************************************************80 + +void hcc_compute_np ( int n, int np, double p[], double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCC_COMPUTE_NP computes a Hermite-Cubic-Chebyshev-Spacing quadrature rule. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into Chebyshev-spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::hcc_compute ( n, x, w ); + + return; +} +//****************************************************************************80 + +void hcc_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCC_COMPUTE_POINTS computes Hermite-Cubic-Chebyshev-Spacing quadrature points. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into Chebyshev-spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 24 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double X[N], the abscissas. +// +{ + int nhalf; + double *xhalf; + + if ( ( n % 2 ) != 0 ) + { + std::cerr << "\n"; + std::cerr << "HCC_COMPUTE_POINTS - Fatal error!\n"; + std::cerr << " Order of rule N is not even.\n"; + std::exit ( 1 ); + } + + nhalf = n / 2; + xhalf = new double[nhalf]; + + webbur::clenshaw_curtis_compute_points ( nhalf, xhalf ); + webbur::r8vec_stutter ( nhalf, xhalf, 2, x ); + + delete [] xhalf; + + return; +} +//****************************************************************************80 + +void hcc_compute_points_np ( int n, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCC_COMPUTE_POINTS_NP: Hermite-Cubic-Chebyshev-Spacing quadrature points. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into Chebyshev-spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + webbur::hcc_compute_points ( n, x ); + + return; +} +//****************************************************************************80 + +void hcc_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCC_COMPUTE_WEIGHTS: Hermite-Cubic-Chebyshev-Spacing quadrature weights. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into Chebyshev-spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 24 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double W[N], the weights. +// +{ + int nhalf; + double *xhalf; + + if ( ( n % 2 ) != 0 ) + { + std::cerr << "\n"; + std::cerr << "HCC_COMPUTE_WEIGHTS - Fatal error!\n"; + std::cerr << " Order of rule N is not even.\n"; + std::exit ( 1 ); + } + + nhalf = n / 2; + xhalf = new double[nhalf]; + + webbur::hc_compute_weights_from_points ( nhalf, xhalf, w ); + + delete [] xhalf; + + return; +} +//****************************************************************************80 + +void hcc_compute_weights_np ( int n, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCC_COMPUTE_WEIGHTS_NP: Hermite-Cubic-Chebyshev-Spacing quadrature weights. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into Chebyshev-spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + webbur::hcc_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void hce_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCE_COMPUTE computes a Hermite-Cubic-Equal-Spacing quadrature rule. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into equally spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 28 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double a_high = 1.0; + double a_low = 0.0; + int nhalf; + double *xhalf; + + a_low = 0.0; + a_high = 1.0; + + nhalf = n / 2; + + xhalf = webbur::r8vec_linspace_new ( nhalf, a_low, a_high ); + webbur::r8vec_stutter ( nhalf, xhalf, 2, x ); + webbur::hc_compute_weights_from_points ( nhalf, xhalf, w ); + + delete [] xhalf; + + return; +} +//****************************************************************************80 + +void hce_compute_np ( int n, int np, double p[], double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCE_COMPUTE_NP computes a Hermite-Cubic-Equal-Spacing quadrature rule. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into equally spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::hce_compute ( n, x, w ); + + return; +} +//****************************************************************************80 + +void hce_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCE_COMPUTE_POINTS computes Hermite-Cubic-Equal-Spacing quadrature points. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into equally spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double X[N], the abscissas. +// +{ + int i; + int j; + int m; + double x_value; + + if ( ( n % 2 ) != 0 ) + { + std::cerr << "\n"; + std::cerr << "HCE_COMPUTE_POINTS - Fatal error!\n"; + std::cerr << " Order of rule N is not even.\n"; + std::exit ( 1 ); + } + m = n / 2; + + for ( j = 0; j < m; j++ ) + { + x_value = ( double ) ( 2 * j + 1 - m ) / ( double ) ( m - 1 ); + for ( i = 0; i < 2; i++ ) + { + x[i+j*2] = x_value; + } + } + return; +} +//****************************************************************************80 + +void hce_compute_points_np ( int n, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCE_COMPUTE_POINTS_NP: Hermite-Cubic-Equal-Spacing quadrature points. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into equally spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + webbur::hce_compute_points ( n, x ); + + return; +} +//****************************************************************************80 + +void hce_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCE_COMPUTE_WEIGHTS: Hermite-Cubic-Equal-Spacing quadrature weights. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into equally spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 24 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double W[N], the weights. +// +{ + int nhalf; + double *xhalf; + + if ( ( n % 2 ) != 0 ) + { + std::cerr << "\n"; + std::cerr << "HCE_COMPUTE_WEIGHTS - Fatal error!\n"; + std::cerr << " Order of rule N is not even.\n"; + std::exit ( 1 ); + } + + nhalf = n / 2; + xhalf = new double[nhalf]; + + webbur::hc_compute_weights_from_points ( nhalf, xhalf, w ); + + delete [] xhalf; + + return; +} +//****************************************************************************80 + +void hce_compute_weights_np ( int n, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HCE_COMPUTE_WEIGHTS_NP: Hermite-Cubic-Equal-Spacing quadrature weights. +// +// Discussion: +// +// For the HCE rule, we assume that an interval has been divided by +// M nodes X into equally spaced subintervals, and that at each +// abscissa both function and derivative information is available. +// The piecewise cubic Hermite interpolant is constructed for this data. +// The quadrature rule uses N = 2 * M abscissas, where each node is +// listed twice, and the weights occur in pairs, with the first multiplying +// the function value and the second the derivative. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + webbur::hce_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void hermite_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_COMPUTE computes a Gauss-Hermite quadrature rule. +// +// Discussion: +// +// The code uses an algorithm by Elhay and Kautsky. +// +// The abscissas are the zeros of the N-th order Hermite polynomial. +// +// The integral: +// +// integral ( -oo < x < +oo ) exp ( - x * x ) * f(x) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky. +// C++ version by John Burkardt. +// +// Reference: +// +// Sylvan Elhay, Jaroslav Kautsky, +// Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of +// Interpolatory Quadrature, +// ACM Transactions on Mathematical Software, +// Volume 13, Number 4, December 1987, pages 399-415. +// +// Parameters: +// +// Input, int N, the number of abscissas. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double arg; + double *bj; + int i; + double zemu; +// +// Define the zero-th moment. +// + arg = 0.5; + zemu = webbur::r8_gamma ( arg ); +// +// Define the Jacobi matrix. +// + bj = new double[n]; + + for ( i = 0; i < n; i++ ) + { + bj[i] = std::sqrt ( ( double ) ( i + 1 ) / 2.0 ); + } + + for ( i = 0; i < n; i++ ) + { + x[i] = 0.0; + } + + w[0] = std::sqrt ( zemu ); + for ( i = 1; i < n; i++ ) + { + w[i] = 0.0; + } +// +// Diagonalize the Jacobi matrix. +// + webbur::imtqlx ( n, x, bj, w ); + + for ( i = 0; i < n; i++ ) + { + w[i] = w[i] * w[i]; + } + + delete [] bj; + + return; +} +//****************************************************************************80 + +void hermite_compute_np ( int order, int np, double p[], double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_COMPUTE_NP computes a Hermite quadrature rule. +// +// Discussion: +// +// The abscissas are the zeros of the N-th order Hermite polynomial. +// +// The integral: +// +// Integral ( -oo < X < +oo ) exp ( - X * X ) * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + webbur::hermite_compute ( order, x, w ); + + return; +} +//****************************************************************************80 + +void hermite_compute_points ( int order, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_COMPUTE_POINTS computes Hermite quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Output, double X[ORDER], the abscissas. +// +{ + double *w; + + w = new double[order]; + + webbur::hermite_compute ( order, x, w ); + + delete [] w; + + return; +} +//****************************************************************************80 + +void hermite_compute_points_np ( int order, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_COMPUTE_POINTS_NP computes Hermite quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[ORDER], the abscissas. +// +{ + webbur::hermite_compute_points ( order, x ); + + return; +} +//****************************************************************************80 + +void hermite_compute_weights ( int order, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_COMPUTE_WEIGHTS computes Hermite quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Output, double W[ORDER], the weights. +// +{ + double *x; + + x = new double[order]; + + webbur::hermite_compute ( order, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void hermite_compute_weights_np ( int order, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_COMPUTE_WEIGHTS_NP computes Hermite quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[ORDER], the weights. +// +{ + webbur::hermite_compute_weights ( order, w ); + + return; +} +//****************************************************************************80 + +void hermite_genz_keister_lookup ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_GENZ_KEISTER_LOOKUP looks up a Genz-Keister Hermite rule. +// +// Discussion: +// +// The integral: +// +// integral ( -oo <= x <= +oo ) f(x) exp ( - x * x ) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// A nested family of rules for the Hermite integration problem +// was produced by Genz and Keister. The structure of the nested +// family was denoted by 1+2+6+10+16, that is, it comprised rules +// of successive orders O = 1, 3, 9, 19, and 35. +// +// The precisions of these rules are P = 1, 5, 15, 29, and 51. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 June 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Alan Genz, Bradley Keister, +// Fully symmetric interpolatory rules for multiple integrals +// over infinite regions with Gaussian weight, +// Journal of Computational and Applied Mathematics, +// Volume 71, 1996, pages 299-309 +// +// Florian Heiss, Viktor Winschel, +// Likelihood approximation by numerical integration on sparse grids, +// Journal of Econometrics, +// Volume 144, 2008, pages 62-80. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// N must be 1, 3, 9, 19, 35, 37, 41 or 43. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::hermite_genz_keister_lookup_points ( n, x ); + webbur::hermite_genz_keister_lookup_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void hermite_genz_keister_lookup_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_GENZ_KEISTER_LOOKUP_POINTS looks up Genz-Keister Hermite abscissas. +// +// Discussion: +// +// The integral: +// +// integral ( -oo <= x <= +oo ) f(x) exp ( - x * x ) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// A nested family of rules for the Hermite integration problem +// was produced by Genz and Keister. The structure of the nested +// family was denoted by 1+2+6+10+?, that is, it comprised rules +// of successive orders O = 1, 3, 9, 19, and a final rule of order +// 35, 37, 41 or 43. +// +// The precisions of these rules are P = 1, 5, 15, 29, +// with the final rule of precision 51, 55, 63 or 67. +// +// Three related families begin the same way, but end with a different final +// rule. As a convenience, this function includes these final rules as well: +// +// Designation Orders Precisions +// +// 1+2+6+10+16, 1,3,9,19,35 1,5,15,29,51 +// 1+2+6+10+18 1,3,9,19,37 1,5,15,29,55 +// 1+2+6+10+22 1,3,9,19,41 1,5,15,29,63 +// 1+2+6+10+24 1,3,9,19,43 1,5,15,29,67 +// +// Some of the data in this function was kindly supplied directly by +// Alan Genz on 24 April 2011. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 04 October 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Alan Genz, Bradley Keister, +// Fully symmetric interpolatory rules for multiple integrals +// over infinite regions with Gaussian weight, +// Journal of Computational and Applied Mathematics, +// Volume 71, 1996, pages 299-309 +// +// Florian Heiss, Viktor Winschel, +// Likelihood approximation by numerical integration on sparse grids, +// Journal of Econometrics, +// Volume 144, 2008, pages 62-80. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// N must be 1, 3, 9, 19, 35, 37, 41, or 43. +// +// Output, double X[N], the abscissas. +// +{ + if ( n == 1 ) + { + x[ 0] = 0.0000000000000000E+00; + } + else if ( n == 3 ) + { + x[ 0] = -1.2247448713915889E+00; + x[ 1] = 0.0000000000000000E+00; + x[ 2] = 1.2247448713915889E+00; + } + else if ( n == 9 ) + { + x[ 0] = -2.9592107790638380E+00; + x[ 1] = -2.0232301911005157E+00; + x[ 2] = -1.2247448713915889E+00; + x[ 3] = -5.2403354748695763E-01; + x[ 4] = 0.0000000000000000E+00; + x[ 5] = 5.2403354748695763E-01; + x[ 6] = 1.2247448713915889E+00; + x[ 7] = 2.0232301911005157E+00; + x[ 8] = 2.9592107790638380E+00; + } + else if ( n == 19 ) + { + x[ 0] = -4.4995993983103881E+00; + x[ 1] = -3.6677742159463378E+00; + x[ 2] = -2.9592107790638380E+00; + x[ 3] = -2.2665132620567876E+00; + x[ 4] = -2.0232301911005157E+00; + x[ 5] = -1.8357079751751868E+00; + x[ 6] = -1.2247448713915889E+00; + x[ 7] = -8.7004089535290285E-01; + x[ 8] = -5.2403354748695763E-01; + x[ 9] = 0.0000000000000000E+00; + x[10] = 5.2403354748695763E-01; + x[11] = 8.7004089535290285E-01; + x[12] = 1.2247448713915889E+00; + x[13] = 1.8357079751751868E+00; + x[14] = 2.0232301911005157E+00; + x[15] = 2.2665132620567876E+00; + x[16] = 2.9592107790638380E+00; + x[17] = 3.6677742159463378E+00; + x[18] = 4.4995993983103881E+00; + } + else if ( n == 35 ) + { + x[ 0] = -6.3759392709822356E+00; + x[ 1] = -5.6432578578857449E+00; + x[ 2] = -5.0360899444730940E+00; + x[ 3] = -4.4995993983103881E+00; + x[ 4] = -4.0292201405043713E+00; + x[ 5] = -3.6677742159463378E+00; + x[ 6] = -3.3491639537131945E+00; + x[ 7] = -2.9592107790638380E+00; + x[ 8] = -2.5705583765842968E+00; + x[ 9] = -2.2665132620567876E+00; + x[10] = -2.0232301911005157E+00; + x[11] = -1.8357079751751868E+00; + x[12] = -1.5794121348467671E+00; + x[13] = -1.2247448713915889E+00; + x[14] = -8.7004089535290285E-01; + x[15] = -5.2403354748695763E-01; + x[16] = -1.7606414208200893E-01; + x[17] = 0.0000000000000000E+00; + x[18] = 1.7606414208200893E-01; + x[19] = 5.2403354748695763E-01; + x[20] = 8.7004089535290285E-01; + x[21] = 1.2247448713915889E+00; + x[22] = 1.5794121348467671E+00; + x[23] = 1.8357079751751868E+00; + x[24] = 2.0232301911005157E+00; + x[25] = 2.2665132620567876E+00; + x[26] = 2.5705583765842968E+00; + x[27] = 2.9592107790638380E+00; + x[28] = 3.3491639537131945E+00; + x[29] = 3.6677742159463378E+00; + x[30] = 4.0292201405043713E+00; + x[31] = 4.4995993983103881E+00; + x[32] = 5.0360899444730940E+00; + x[33] = 5.6432578578857449E+00; + x[34] = 6.3759392709822356E+00; + } + else if ( n == 37 ) + { + x[ 0] = -6.853200069757519; + x[ 1] = -6.124527854622158; + x[ 2] = -5.521865209868350; + x[ 3] = -4.986551454150765; + x[ 4] = -4.499599398310388; + x[ 5] = -4.057956316089741; + x[ 6] = -3.667774215946338; + x[ 7] = -3.315584617593290; + x[ 8] = -2.959210779063838; + x[ 9] = -2.597288631188366; + x[10] = -2.266513262056788; + x[11] = -2.023230191100516; + x[12] = -1.835707975175187; + x[13] = -1.561553427651873; + x[14] = -1.224744871391589; + x[15] = -0.870040895352903; + x[16] = -0.524033547486958; + x[17] = -0.214618180588171; + x[18] = 0.000000000000000; + x[19] = 0.214618180588171; + x[20] = 0.524033547486958; + x[21] = 0.870040895352903; + x[22] = 1.224744871391589; + x[23] = 1.561553427651873; + x[24] = 1.835707975175187; + x[25] = 2.023230191100516; + x[26] = 2.266513262056788; + x[27] = 2.597288631188366; + x[28] = 2.959210779063838; + x[29] = 3.315584617593290; + x[30] = 3.667774215946338; + x[31] = 4.057956316089741; + x[32] = 4.499599398310388; + x[33] = 4.986551454150765; + x[34] = 5.521865209868350; + x[35] = 6.124527854622158; + x[36] = 6.853200069757519; + } + else if ( n == 41 ) + { + x[ 0] = -7.251792998192644; + x[ 1] = -6.547083258397540; + x[ 2] = -5.961461043404500; + x[ 3] = -5.437443360177798; + x[ 4] = -4.953574342912980; + x[ 5] = -4.4995993983103881; + x[ 6] = -4.070919267883068; + x[ 7] = -3.6677742159463378; + x[ 8] = -3.296114596212218; + x[ 9] = -2.9592107790638380; + x[10] = -2.630415236459871; + x[11] = -2.2665132620567876; + x[12] = -2.043834754429505; + x[13] = -2.0232301911005157; + x[14] = -1.8357079751751868; + x[15] = -1.585873011819188; + x[16] = -1.2247448713915889; + x[17] = -0.87004089535290285; + x[18] = -0.52403354748695763; + x[19] = -0.195324784415805; + x[20] = 0.0000000000000000; + x[21] = 0.195324784415805; + x[22] = 0.52403354748695763; + x[23] = 0.87004089535290285; + x[24] = 1.2247448713915889; + x[25] = 1.585873011819188; + x[26] = 1.8357079751751868; + x[27] = 2.0232301911005157; + x[28] = 2.043834754429505; + x[29] = 2.2665132620567876; + x[30] = 2.630415236459871; + x[31] = 2.9592107790638380; + x[32] = 3.296114596212218; + x[33] = 3.6677742159463378; + x[34] = 4.070919267883068; + x[35] = 4.4995993983103881; + x[36] = 4.953574342912980; + x[37] = 5.437443360177798; + x[38] = 5.961461043404500; + x[39] = 6.547083258397540; + x[40] = 7.251792998192644; + } + else if ( n == 43 ) + { + x[ 0] = -10.167574994881873; + x[ 1] = -7.231746029072501; + x[ 2] = -6.535398426382995; + x[ 3] = -5.954781975039809; + x[ 4] = -5.434053000365068; + x[ 5] = -4.952329763008589; + x[ 6] = -4.4995993983103881; + x[ 7] = -4.071335874253583; + x[ 8] = -3.6677742159463378; + x[ 9] = -3.295265921534226; + x[10] = -2.9592107790638380; + x[11] = -2.633356763661946; + x[12] = -2.2665132620567876; + x[13] = -2.089340389294661; + x[14] = -2.0232301911005157; + x[15] = -1.8357079751751868; + x[16] = -1.583643465293944; + x[17] = -1.2247448713915889; + x[18] = -0.87004089535290285; + x[19] = -0.52403354748695763; + x[20] = -0.196029453662011; + x[21] = 0.0000000000000000; + x[22] = 0.196029453662011; + x[23] = 0.52403354748695763; + x[24] = 0.87004089535290285; + x[25] = 1.2247448713915889; + x[26] = 1.583643465293944; + x[27] = 1.8357079751751868; + x[28] = 2.0232301911005157; + x[29] = 2.089340389294661; + x[30] = 2.2665132620567876; + x[31] = 2.633356763661946; + x[32] = 2.9592107790638380; + x[33] = 3.295265921534226; + x[34] = 3.6677742159463378; + x[35] = 4.071335874253583; + x[36] = 4.4995993983103881; + x[37] = 4.952329763008589; + x[38] = 5.434053000365068; + x[39] = 5.954781975039809; + x[40] = 6.535398426382995; + x[41] = 7.231746029072501; + x[42] = 10.167574994881873; + } + else + { + std::cerr << "\n"; + std::cerr << "HERMITE_GENZ_KEISTER_LOOKUP_POINTS - Fatal error!\n"; + std::cerr << " Illegal input value of N.\n"; + std::cerr << " N must be 1, 3, 9, 19, 35, 37, 41 or 43.\n"; + std::exit ( 1 ); + } + return; +} +//****************************************************************************80 + +void hermite_genz_keister_lookup_points_np ( int n, int np, double p[], + double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_GENZ_KEISTER_LOOKUP_POINTS_NP looks up Genz-Keister Hermite abscissas. +// +// Discussion: +// +// The integral: +// +// integral ( -oo <= x <= +oo ) f(x) exp ( - x * x ) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// A nested family of rules for the Hermite integration problem +// was produced by Genz and Keister. The structure of the nested +// family was denoted by 1+2+6+10+?, that is, it comprised rules +// of successive orders O = 1, 3, 9, 19, and a final rule of order +// 35, 37, 41 or 43. +// +// The precisions of these rules are P = 1, 5, 15, 29, +// with the final rule of precision 51, 55, 63 or 67. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 04 October 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Alan Genz, Bradley Keister, +// Fully symmetric interpolatory rules for multiple integrals +// over infinite regions with Gaussian weight, +// Journal of Computational and Applied Mathematics, +// Volume 71, 1996, pages 299-309 +// +// Florian Heiss, Viktor Winschel, +// Likelihood approximation by numerical integration on sparse grids, +// Journal of Econometrics, +// Volume 144, 2008, pages 62-80. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// N must be 1, 3, 9, 19, 35, 37, 41 or 43. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + webbur::hermite_genz_keister_lookup_points ( n, x ); + + return; +} +//****************************************************************************80 + +void hermite_genz_keister_lookup_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_GENZ_KEISTER_LOOKUP_WEIGHTS looks up Genz-Keister Hermite weights. +// +// Discussion: +// +// The integral: +// +// integral ( -oo <= x <= +oo ) f(x) exp ( - x * x ) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// A nested family of rules for the Hermite integration problem +// was produced by Genz and Keister. The structure of the nested +// family was denoted by 1+2+6+10+?, that is, it comprised rules +// of successive orders O = 1, 3, 9, 19, and a final rule of order +// 35, 37, 41 or 43. +// +// The precisions of these rules are P = 1, 5, 15, 29, +// with the final rule of precision 51, 55, 63 or 67. +// +// Three related families begin the same way, but end with a different final +// rule. As a convenience, this function includes these final rules as well: +// +// Designation Orders Precisions +// +// 1+2+6+10+16, 1,3,9,19,35 1,5,15,29,51 +// 1+2+6+10+18 1,3,9,19,37 1,5,15,29,55 +// 1+2+6+10+22 1,3,9,19,41 1,5,15,29,63 +// 1+2+6+10+24 1,3,9,19,43 1,5,15,29,67 +// +// Some of the data in this function was kindly supplied directly by +// Alan Genz on 24 April 2011. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 04 October 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Alan Genz, Bradley Keister, +// Fully symmetric interpolatory rules for multiple integrals +// over infinite regions with Gaussian weight, +// Journal of Computational and Applied Mathematics, +// Volume 71, 1996, pages 299-309 +// +// Florian Heiss, Viktor Winschel, +// Likelihood approximation by numerical integration on sparse grids, +// Journal of Econometrics, +// Volume 144, 2008, pages 62-80. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// N must be 1, 3, 9, 19, 35, 37, 41, or 43. +// +// Output, double W[N], the weights. +// +{ + static double sqrtpi = 1.7724538509055159; + + if ( n == 1 ) + { + w[ 0] = 1.7724538509055159E+00; + } + else if ( n == 3 ) + { + w[ 0] = 2.9540897515091930E-01; + w[ 1] = 1.1816359006036772E+00; + w[ 2] = 2.9540897515091930E-01; + } + else if ( n == 9 ) + { + w[ 0] = 1.6708826306882348E-04; + w[ 1] = 1.4173117873979098E-02; + w[ 2] = 1.6811892894767771E-01; + w[ 3] = 4.7869428549114124E-01; + w[ 4] = 4.5014700975378197E-01; + w[ 5] = 4.7869428549114124E-01; + w[ 6] = 1.6811892894767771E-01; + w[ 7] = 1.4173117873979098E-02; + w[ 8] = 1.6708826306882348E-04; + } + else if ( n == 19 ) + { + w[ 0] = 1.5295717705322357E-09; + w[ 1] = 1.0802767206624762E-06; + w[ 2] = 1.0656589772852267E-04; + w[ 3] = 5.1133174390883855E-03; + w[ 4] = -1.1232438489069229E-02; + w[ 5] = 3.2055243099445879E-02; + w[ 6] = 1.1360729895748269E-01; + w[ 7] = 1.0838861955003017E-01; + w[ 8] = 3.6924643368920851E-01; + w[ 9] = 5.3788160700510168E-01; + w[10] = 3.6924643368920851E-01; + w[11] = 1.0838861955003017E-01; + w[12] = 1.1360729895748269E-01; + w[13] = 3.2055243099445879E-02; + w[14] = -1.1232438489069229E-02; + w[15] = 5.1133174390883855E-03; + w[16] = 1.0656589772852267E-04; + w[17] = 1.0802767206624762E-06; + w[18] = 1.5295717705322357E-09; + } + else if ( n == 35 ) + { + w[ 0] = 1.8684014894510604E-18; + w[ 1] = 9.6599466278563243E-15; + w[ 2] = 5.4896836948499462E-12; + w[ 3] = 8.1553721816916897E-10; + w[ 4] = 3.7920222392319532E-08; + w[ 5] = 4.3737818040926989E-07; + w[ 6] = 4.8462799737020461E-06; + w[ 7] = 6.3328620805617891E-05; + w[ 8] = 4.8785399304443770E-04; + w[ 9] = 1.4515580425155904E-03; + w[10] = 4.0967527720344047E-03; + w[11] = 5.5928828911469180E-03; + w[12] = 2.7780508908535097E-02; + w[13] = 8.0245518147390893E-02; + w[14] = 1.6371221555735804E-01; + w[15] = 2.6244871488784277E-01; + w[16] = 3.3988595585585218E-01; + w[17] = 9.1262675363737921E-04; + w[18] = 3.3988595585585218E-01; + w[19] = 2.6244871488784277E-01; + w[20] = 1.6371221555735804E-01; + w[21] = 8.0245518147390893E-02; + w[22] = 2.7780508908535097E-02; + w[23] = 5.5928828911469180E-03; + w[24] = 4.0967527720344047E-03; + w[25] = 1.4515580425155904E-03; + w[26] = 4.8785399304443770E-04; + w[27] = 6.3328620805617891E-05; + w[28] = 4.8462799737020461E-06; + w[29] = 4.3737818040926989E-07; + w[30] = 3.7920222392319532E-08; + w[31] = 8.1553721816916897E-10; + w[32] = 5.4896836948499462E-12; + w[33] = 9.6599466278563243E-15; + w[34] = 1.8684014894510604E-18; + } + else if ( n == 37 ) + { + w[ 0] = 0.337304188079177058E-20; + w[ 1] = 0.332834739632930463E-16; + w[ 2] = 0.323016866782871498E-13; + w[ 3] = 0.809333688669950037E-11; + w[ 4] = 0.748907559239519284E-09; + w[ 5] = 0.294146671497083432E-07; + w[ 6] = 0.524482423744884136E-06; + w[ 7] = 0.586639457073896277E-05; + w[ 8] = 0.571885531470621903E-04; + w[ 9] = 0.41642095727577091E-03; + w[10] = 0.174733389581099482E-02; + w[11] = 0.313373786000304381E-02; + w[12] = 0.768092665770660459E-02; + w[13] = 0.274962713372148476E-01; + w[14] = 0.783630990508037449E-01; + w[15] = 0.16611584261479281E+00; + w[16] = 0.253636910481387185E+00; + w[17] = 0.261712932511430884E+00; + w[18] = 0.171719680968980257E+00; + w[19] = 0.261712932511430884E+00; + w[20] = 0.253636910481387185E+00; + w[21] = 0.16611584261479281E+00; + w[22] = 0.783630990508037449E-01; + w[23] = 0.274962713372148476E-01; + w[24] = 0.768092665770660459E-02; + w[25] = 0.313373786000304381E-02; + w[26] = 0.174733389581099482E-02; + w[27] = 0.41642095727577091E-03; + w[28] = 0.571885531470621903E-04; + w[29] = 0.586639457073896277E-05; + w[30] = 0.524482423744884136E-06; + w[31] = 0.294146671497083432E-07; + w[32] = 0.748907559239519284E-09; + w[33] = 0.809333688669950037E-11; + w[34] = 0.323016866782871498E-13; + w[35] = 0.332834739632930463E-16; + w[36] = 0.337304188079177058E-20; + } + else if ( n == 41 ) + { + w[ 0] = 0.117725656974405367E-22; + w[ 1] = 0.152506745534300636E-18; + w[ 2] = 0.202183949965101288E-15; + w[ 3] = 0.724614869051195508E-13; + w[ 4] = 0.103121966469463034E-10; + w[ 5] = 0.710371395169350952E-09; + w[ 6] = 0.264376044449260516E-07; + w[ 7] = 0.558982787078644997E-06; + w[ 8] = 0.675628907134744976E-05; + w[ 9] = 0.512198007019776873E-04; + w[10] = 0.335013114947200879E-03; + w[11] = 0.249379691096933139E-02; + w[12] = - 0.25616995850607458E-01; + w[13] = 0.317007878644325588E-01; + w[14] = 0.125041498584003435E-02; + w[15] = 0.293244560924894295E-01; + w[16] = 0.799536390803302298E-01; + w[17] = 0.164543666806555251E+00; + w[18] = 0.258718519718241095E+00; + w[19] = 0.293588795735908566E+00; + w[20] = 0.997525375254611951E-01; + w[21] = 0.293588795735908566E+00; + w[22] = 0.258718519718241095E+00; + w[23] = 0.164543666806555251E+00; + w[24] = 0.799536390803302298E-01; + w[25] = 0.293244560924894295E-01; + w[26] = 0.125041498584003435E-02; + w[27] = 0.317007878644325588E-01; + w[28] = - 0.25616995850607458E-01; + w[29] = 0.249379691096933139E-02; + w[30] = 0.335013114947200879E-03; + w[31] = 0.512198007019776873E-04; + w[32] = 0.675628907134744976E-05; + w[33] = 0.558982787078644997E-06; + w[34] = 0.264376044449260516E-07; + w[35] = 0.710371395169350952E-09; + w[36] = 0.103121966469463034E-10; + w[37] = 0.724614869051195508E-13; + w[38] = 0.202183949965101288E-15; + w[39] = 0.152506745534300636E-18; + w[40] = 0.117725656974405367E-22; + } + else if ( n == 43 ) + { + w[ 0] = 0.968100020641528185E-37; + w[ 1] = 0.15516931262860431E-22; + w[ 2] = 0.175937309107750992E-18; + w[ 3] = 0.217337608710893738E-15; + w[ 4] = 0.747837010380540069E-13; + w[ 5] = 0.104028132097205732E-10; + w[ 6] = 0.70903573389336778E-09; + w[ 7] = 0.263481722999966618E-07; + w[ 8] = 0.560127964848432175E-06; + w[ 9] = 0.680410934802210232E-05; + w[10] = 0.508343873102544037E-04; + w[11] = 0.32753080006610181E-03; + w[12] = 0.267479828788552937E-02; + w[13] = - 0.687704270963253854E-02; + w[14] = 0.119383201790913588E-01; + w[15] = 0.248083722871002796E-02; + w[16] = 0.29000335749726387E-01; + w[17] = 0.798689557875757008E-01; + w[18] = 0.164609842422580606E+00; + w[19] = 0.258535954731607738E+00; + w[20] = 0.292243810406117141E+00; + w[21] = 0.102730713753441829E+00; + w[22] = 0.292243810406117141E+00; + w[23] = 0.258535954731607738E+00; + w[24] = 0.164609842422580606E+00; + w[25] = 0.798689557875757008E-01; + w[26] = 0.29000335749726387E-01; + w[27] = 0.248083722871002796E-02; + w[28] = 0.119383201790913588E-01; + w[29] = - 0.687704270963253854E-02; + w[30] = 0.267479828788552937E-02; + w[31] = 0.32753080006610181E-03; + w[32] = 0.508343873102544037E-04; + w[33] = 0.680410934802210232E-05; + w[34] = 0.560127964848432175E-06; + w[35] = 0.263481722999966618E-07; + w[36] = 0.70903573389336778E-09; + w[37] = 0.104028132097205732E-10; + w[38] = 0.747837010380540069E-13; + w[39] = 0.217337608710893738E-15; + w[40] = 0.175937309107750992E-18; + w[41] = 0.15516931262860431E-22; + w[42] = 0.968100020641528185E-37; + } + else + { + std::cerr << "\n"; + std::cerr << "HERMITE_GENZ_KEISTER_LOOKUP_WEIGHTS - Fatal error!\n"; + std::cerr << " Illegal input value of N.\n"; + std::cerr << " N must be 1, 3, 9, 19, 35, 37, 41 or 43.\n"; + std::exit ( 1 ); + } + return; +} +//****************************************************************************80 + +void hermite_genz_keister_lookup_weights_np ( int n, int np, double p[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_GENZ_KEISTER_LOOKUP_WEIGHTS_NP looks up Genz-Keister Hermite weights. +// +// Discussion: +// +// The integral: +// +// integral ( -oo <= x <= +oo ) f(x) exp ( - x * x ) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// A nested family of rules for the Hermite integration problem +// was produced by Genz and Keister. The structure of the nested +// family was denoted by 1+2+6+10+?, that is, it comprised rules +// of successive orders O = 1, 3, 9, 19, and a final rule of order +// 35, 37, 41 or 43. +// +// The precisions of these rules are P = 1, 5, 15, 29, +// with the final rule of precision 51, 55, 63 or 67. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 04 October 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Alan Genz, Bradley Keister, +// Fully symmetric interpolatory rules for multiple integrals +// over infinite regions with Gaussian weight, +// Journal of Computational and Applied Mathematics, +// Volume 71, 1996, pages 299-309 +// +// Florian Heiss, Viktor Winschel, +// Likelihood approximation by numerical integration on sparse grids, +// Journal of Econometrics, +// Volume 144, 2008, pages 62-80. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// N must be 1, 3, 9, 19, 35, 37, 41 or 43. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + webbur::hermite_genz_keister_lookup_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void hermite_gk18_lookup_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_GK18_LOOKUP_POINTS: abscissas of a Hermite Genz-Keister 18 rule. +// +// Discussion: +// +// The integral: +// +// integral ( -oo <= x <= +oo ) f(x) exp ( - x * x ) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// A nested family of rules for the Hermite integration problem +// was produced by Genz and Keister. The structure of the nested +// family was denoted by 1+2+6+10+18, that is, it comprised rules +// of successive orders O = 1, 3, 9, 19, and 37. +// +// The precisions of these rules are P = 1, 5, 15, 29, and 55. +// +// Some of the data in this function was kindly supplied directly by +// Alan Genz on 24 April 2011. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 30 April 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Alan Genz, Bradley Keister, +// Fully symmetric interpolatory rules for multiple integrals +// over infinite regions with Gaussian weight, +// Journal of Computational and Applied Mathematics, +// Volume 71, 1996, pages 299-309 +// +// Florian Heiss, Viktor Winschel, +// Likelihood approximation by numerical integration on sparse grids, +// Journal of Econometrics, +// Volume 144, 2008, pages 62-80. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// N must be 1, 3, 9, 19, or 37. +// +// Output, double X[N], the abscissas. +// +{ + if ( n == 1 ) + { + x[ 0] = 0.0000000000000000E+00; + } + else if ( n == 3 ) + { + x[ 0] = -1.2247448713915889E+00; + x[ 1] = 0.0000000000000000E+00; + x[ 2] = 1.2247448713915889E+00; + } + else if ( n == 9 ) + { + x[ 0] = -2.9592107790638380E+00; + x[ 1] = -2.0232301911005157E+00; + x[ 2] = -1.2247448713915889E+00; + x[ 3] = -5.2403354748695763E-01; + x[ 4] = 0.0000000000000000E+00; + x[ 5] = 5.2403354748695763E-01; + x[ 6] = 1.2247448713915889E+00; + x[ 7] = 2.0232301911005157E+00; + x[ 8] = 2.9592107790638380E+00; + } + else if ( n == 19 ) + { + x[ 0] = -4.4995993983103881E+00; + x[ 1] = -3.6677742159463378E+00; + x[ 2] = -2.9592107790638380E+00; + x[ 3] = -2.2665132620567876E+00; + x[ 4] = -2.0232301911005157E+00; + x[ 5] = -1.8357079751751868E+00; + x[ 6] = -1.2247448713915889E+00; + x[ 7] = -8.7004089535290285E-01; + x[ 8] = -5.2403354748695763E-01; + x[ 9] = 0.0000000000000000E+00; + x[10] = 5.2403354748695763E-01; + x[11] = 8.7004089535290285E-01; + x[12] = 1.2247448713915889E+00; + x[13] = 1.8357079751751868E+00; + x[14] = 2.0232301911005157E+00; + x[15] = 2.2665132620567876E+00; + x[16] = 2.9592107790638380E+00; + x[17] = 3.6677742159463378E+00; + x[18] = 4.4995993983103881E+00; + } + else if ( n == 35 ) + { + x[ 0] = -6.853200069757519; + x[ 1] = -6.124527854622158; + x[ 2] = -5.521865209868350; + x[ 3] = -4.986551454150765; + x[ 4] = -4.499599398310388; + x[ 5] = -4.057956316089741; + x[ 6] = -3.667774215946338; + x[ 7] = -3.315584617593290; + x[ 8] = -2.959210779063838; + x[ 9] = -2.597288631188366; + x[10] = -2.266513262056788; + x[11] = -2.023230191100516; + x[12] = -1.835707975175187; + x[13] = -1.561553427651873; + x[14] = -1.224744871391589; + x[15] = -0.870040895352903; + x[16] = -0.524033547486958; + x[17] = -0.214618180588171; + x[18] = 0.000000000000000; + x[19] = 0.214618180588171; + x[20] = 0.524033547486958; + x[21] = 0.870040895352903; + x[22] = 1.224744871391589; + x[23] = 1.561553427651873; + x[24] = 1.835707975175187; + x[25] = 2.023230191100516; + x[26] = 2.266513262056788; + x[27] = 2.597288631188366; + x[28] = 2.959210779063838; + x[29] = 3.315584617593290; + x[30] = 3.667774215946338; + x[31] = 4.057956316089741; + x[32] = 4.499599398310388; + x[33] = 4.986551454150765; + x[34] = 5.521865209868350; + x[35] = 6.124527854622158; + x[36] = 6.853200069757519; + } + else + { + std::cerr << "\n"; + std::cerr << "HERMITE_GK18_LOOKUP_POINTS - Fatal error!\n"; + std::cerr << " Illegal input value of N.\n"; + std::cerr << " N must be 1, 3, 9, 19, or 37.\n"; + std::exit ( 1 ); + } + return; +} +//****************************************************************************80 + +void hermite_gk22_lookup_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_GK22_LOOKUP_POINTS looks up Hermite Genz-Keister 22 points. +// +// Discussion: +// +// The integral: +// +// integral ( -oo <= x <= +oo ) f(x) exp ( - x * x ) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// A nested family of rules for the Hermite integration problem +// was produced by Genz and Keister. The structure of the nested +// family was denoted by 1+2+6+10+16, that is, it comprised rules +// of successive orders O = 1, 3, 9, 19, and 41. +// +// The precisions of these rules are P = 1, 5, 15, 29, and 63. +// +// Some of the data in this function was kindly supplied directly by +// Alan Genz on 24 April 2011. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 26 April 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Alan Genz, Bradley Keister, +// Fully symmetric interpolatory rules for multiple integrals +// over infinite regions with Gaussian weight, +// Journal of Computational and Applied Mathematics, +// Volume 71, 1996, pages 299-309 +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// N must be 1, 3, 9, 19, or 41. +// +// Output, double X[N], the abscissas. +// +{ + if ( n == 1 ) + { + x[ 0] = 0.0000000000000000E+00; + } + else if ( n == 3 ) + { + x[ 0] = -1.2247448713915889E+00; + x[ 1] = 0.0000000000000000E+00; + x[ 2] = 1.2247448713915889E+00; + } + else if ( n == 9 ) + { + x[ 0] = -2.9592107790638380E+00; + x[ 1] = -2.0232301911005157E+00; + x[ 2] = -1.2247448713915889E+00; + x[ 3] = -5.2403354748695763E-01; + x[ 4] = 0.0000000000000000E+00; + x[ 5] = 5.2403354748695763E-01; + x[ 6] = 1.2247448713915889E+00; + x[ 7] = 2.0232301911005157E+00; + x[ 8] = 2.9592107790638380E+00; + } + else if ( n == 19 ) + { + x[ 0] = -4.4995993983103881E+00; + x[ 1] = -3.6677742159463378E+00; + x[ 2] = -2.9592107790638380E+00; + x[ 3] = -2.2665132620567876E+00; + x[ 4] = -2.0232301911005157E+00; + x[ 5] = -1.8357079751751868E+00; + x[ 6] = -1.2247448713915889E+00; + x[ 7] = -8.7004089535290285E-01; + x[ 8] = -5.2403354748695763E-01; + x[ 9] = 0.0000000000000000E+00; + x[10] = 5.2403354748695763E-01; + x[11] = 8.7004089535290285E-01; + x[12] = 1.2247448713915889E+00; + x[13] = 1.8357079751751868E+00; + x[14] = 2.0232301911005157E+00; + x[15] = 2.2665132620567876E+00; + x[16] = 2.9592107790638380E+00; + x[17] = 3.6677742159463378E+00; + x[18] = 4.4995993983103881E+00; + } + else if ( n == 41 ) + { + x[ 0] = -7.251792998192644; + x[ 1] = -6.547083258397540; + x[ 2] = -5.961461043404500; + x[ 3] = -5.437443360177798; + x[ 4] = -4.953574342912980; + x[ 5] = -4.4995993983103881; + x[ 6] = -4.070919267883068; + x[ 7] = -3.6677742159463378; + x[ 8] = -3.296114596212218; + x[ 9] = -2.9592107790638380; + x[10] = -2.630415236459871; + x[11] = -2.2665132620567876; + x[12] = -2.043834754429505; + x[13] = -2.0232301911005157; + x[14] = -1.8357079751751868; + x[15] = -1.585873011819188; + x[16] = -1.2247448713915889; + x[17] = -0.87004089535290285; + x[18] = -0.52403354748695763; + x[19] = -0.195324784415805; + x[20] = 0.0000000000000000; + x[21] = 0.195324784415805; + x[22] = 0.52403354748695763; + x[23] = 0.87004089535290285; + x[24] = 1.2247448713915889; + x[25] = 1.585873011819188; + x[26] = 1.8357079751751868; + x[27] = 2.0232301911005157; + x[28] = 2.043834754429505; + x[29] = 2.2665132620567876; + x[30] = 2.630415236459871; + x[31] = 2.9592107790638380; + x[32] = 3.296114596212218; + x[33] = 3.6677742159463378; + x[34] = 4.070919267883068; + x[35] = 4.4995993983103881; + x[36] = 4.953574342912980; + x[37] = 5.437443360177798; + x[38] = 5.961461043404500; + x[39] = 6.547083258397540; + x[40] = 7.251792998192644; + } + else + { + std::cerr << "\n"; + std::cerr << "HERMITE_GK22_LOOKUP_POINTS - Fatal error!\n"; + std::cerr << " Illegal input value of N.\n"; + std::cerr << " N must be 1, 3, 9, 19, or 41.\n"; + std::exit ( 1 ); + } + return; +} +//****************************************************************************80 + +void hermite_gk24_lookup_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_GK24_LOOKUP_POINTS looks up Hermite Genz-Keister 24 points. +// +// Discussion: +// +// The integral: +// +// integral ( -oo <= x <= +oo ) f(x) exp ( - x * x ) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ) +// +// A nested family of rules for the Hermite integration problem +// was produced by Genz and Keister. The structure of the nested +// family was denoted by 1+2+6+10+16, that is, it comprised rules +// of successive orders O = 1, 3, 9, 19, and 43. +// +// The precisions of these rules are P = 1, 5, 15, 29, and 67. +// +// Some of the data in this function was kindly supplied directly by +// Alan Genz on 24 April 2011. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 26 April 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Alan Genz, Bradley Keister, +// Fully symmetric interpolatory rules for multiple integrals +// over infinite regions with Gaussian weight, +// Journal of Computational and Applied Mathematics, +// Volume 71, 1996, pages 299-309 +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// N must be 1, 3, 9 19, or 43. +// +// Output, double X[N], the abscissas. +// +{ + if ( n == 1 ) + { + x[ 0] = 0.0000000000000000E+00; + } + else if ( n == 3 ) + { + x[ 0] = -1.2247448713915889E+00; + x[ 1] = 0.0000000000000000E+00; + x[ 2] = 1.2247448713915889E+00; + } + else if ( n == 9 ) + { + x[ 0] = -2.9592107790638380E+00; + x[ 1] = -2.0232301911005157E+00; + x[ 2] = -1.2247448713915889E+00; + x[ 3] = -5.2403354748695763E-01; + x[ 4] = 0.0000000000000000E+00; + x[ 5] = 5.2403354748695763E-01; + x[ 6] = 1.2247448713915889E+00; + x[ 7] = 2.0232301911005157E+00; + x[ 8] = 2.9592107790638380E+00; + } + else if ( n == 19 ) + { + x[ 0] = -4.4995993983103881E+00; + x[ 1] = -3.6677742159463378E+00; + x[ 2] = -2.9592107790638380E+00; + x[ 3] = -2.2665132620567876E+00; + x[ 4] = -2.0232301911005157E+00; + x[ 5] = -1.8357079751751868E+00; + x[ 6] = -1.2247448713915889E+00; + x[ 7] = -8.7004089535290285E-01; + x[ 8] = -5.2403354748695763E-01; + x[ 9] = 0.0000000000000000E+00; + x[10] = 5.2403354748695763E-01; + x[11] = 8.7004089535290285E-01; + x[12] = 1.2247448713915889E+00; + x[13] = 1.8357079751751868E+00; + x[14] = 2.0232301911005157E+00; + x[15] = 2.2665132620567876E+00; + x[16] = 2.9592107790638380E+00; + x[17] = 3.6677742159463378E+00; + x[18] = 4.4995993983103881E+00; + } + else if ( n == 43 ) + { + x[ 0] = -10.167574994881873; + x[ 1] = -7.231746029072501; + x[ 2] = -6.535398426382995; + x[ 3] = -5.954781975039809; + x[ 4] = -5.434053000365068; + x[ 5] = -4.952329763008589; + x[ 6] = -4.4995993983103881; + x[ 7] = -4.071335874253583; + x[ 8] = -3.6677742159463378; + x[ 9] = -3.295265921534226; + x[10] = -2.9592107790638380; + x[11] = -2.633356763661946; + x[12] = -2.2665132620567876; + x[13] = -2.089340389294661; + x[14] = -2.0232301911005157; + x[15] = -1.8357079751751868; + x[16] = -1.583643465293944; + x[17] = -1.2247448713915889; + x[18] = -0.87004089535290285; + x[19] = -0.52403354748695763; + x[20] = -0.196029453662011; + x[21] = 0.0000000000000000; + x[22] = 0.196029453662011; + x[23] = 0.52403354748695763; + x[24] = 0.87004089535290285; + x[25] = 1.2247448713915889; + x[26] = 1.583643465293944; + x[27] = 1.8357079751751868; + x[28] = 2.0232301911005157; + x[29] = 2.089340389294661; + x[30] = 2.2665132620567876; + x[31] = 2.633356763661946; + x[32] = 2.9592107790638380; + x[33] = 3.295265921534226; + x[34] = 3.6677742159463378; + x[35] = 4.071335874253583; + x[36] = 4.4995993983103881; + x[37] = 4.952329763008589; + x[38] = 5.434053000365068; + x[39] = 5.954781975039809; + x[40] = 6.535398426382995; + x[41] = 7.231746029072501; + x[42] = 10.167574994881873; + } + else + { + std::cerr << "\n"; + std::cerr << "HERMITE_GK24_LOOKUP_POINTS - Fatal error!\n"; + std::cerr << " Illegal input value of N.\n"; + std::cerr << " N must be 1, 3, 9, 19, or 43.\n"; + std::exit ( 1 ); + } + return; +} +//****************************************************************************80 + +double hermite_integral ( int n ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_INTEGRAL evaluates a monomial Hermite integral. +// +// Discussion: +// +// H(n) = Integral ( -oo < x < +oo ) x^n exp(-x^2) dx +// +// H(n) is 0 for n odd. +// +// H(n) = (n-1)!! * sqrt(pi) / 2^(n/2) for n even. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order of the integral. +// 0 <= N. +// +// Output, double VALUE, the value of the integral. +// +{ + double pi = 3.141592653589793; + double value; + + if ( n < 0 ) + { + value = - webbur::r8_huge ( ); + } + else if ( ( n % 2 ) == 1 ) + { + value = 0.0; + } + else + { + value = webbur::r8_factorial2 ( n - 1 ) * std::sqrt ( pi ) + / std::pow ( 2.0, n / 2 ); + } + + return value; +} +//****************************************************************************80 + +void hermite_interpolant ( int n, double x[], double y[], double yp[], + double xd[], double yd[], double xdp[], double ydp[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_INTERPOLANT sets up a divided difference table from Hermite data. +// +// Discussion: +// +// The polynomial represented by the divided difference table can be +// evaluated by calling DIF_VALS. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 October 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Carl deBoor, +// A Practical Guide to Splines, +// Springer, 2001, +// ISBN: 0387953663, +// LC: QA1.A647.v27. +// +// Parameters: +// +// Input, int N, of items of data +// ( X(I), Y(I), YP(I) ). +// +// Input, double X[N], the abscissas. +// These values must be distinct. +// +// Input, double Y[N], YP[N], the function and derivative values. +// +// Output, double XD[2*N], YD[2*N], the divided difference table +// for the interpolant value. +// +// Output, double XDP[2*N-1], YDP[2*N-1], the divided difference +// table for the interpolant derivative. +// +{ + int i; + int j; + int nd; + int ndp; +// +// Copy the data. +// + nd = 2 * n; + + for ( i = 0; i < n; i++ ) + { + xd[0+i*2] = x[i]; + xd[1+i*2] = x[i]; + } +// +// Carry out the first step of differencing. +// + yd[0] = y[0]; + for ( i = 1; i < n; i++ ) + { + yd[0+2*i] = ( y[i] - y[i-1] ) / ( x[i] - x[i-1] ); + } + for ( i = 0; i < n; i++ ) + { + yd[1+2*i] = yp[i]; + } +// +// Carry out the remaining steps in the usual way. +// + for ( i = 2; i < nd; i++ ) + { + for ( j = nd - 1; i <= j; j-- ) + { + yd[j] = ( yd[j] - yd[j-1] ) / ( xd[j] - xd[j-i] ); + } + } +// +// Compute the difference table for the derivative. +// + webbur::dif_deriv ( nd, xd, yd, &ndp, xdp, ydp ); + + return; +} +//****************************************************************************80 + +void hermite_interpolant_rule ( int n, double a, double b, double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_INTERPOLANT_RULE: quadrature rule for a Hermite interpolant. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 October 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of abscissas. +// +// Input, double A, B, the integration limits. +// +// Input, double X[N], the abscissas. +// +// Output, double W[2*N], the quadrature +// coefficients, given as pairs for function and derivative values +// at each abscissa. +// +{ + double a_value; + double b_value; + double *c; + int i; + int j; + int k; + int nd; + int ndp; + double *xd; + double *xdp; + double *y; + double *yd; + double *ydp; + double *yp; + + y = new double[n]; + yp = new double[n]; + + nd = 2 * n; + c = new double[nd]; + xd = new double[nd]; + yd = new double[nd]; + + ndp = 2 * n - 1; + xdp = new double[ndp]; + ydp = new double[ndp]; + + for ( i = 0; i < n; i++ ) + { + y[i] = 0.0; + yp[i] = 0.0; + } + + k = 0; + + for ( i = 0; i < n; i++ ) + { + y[i] = 1.0; + webbur::hermite_interpolant ( n, x, y, yp, xd, yd, xdp, ydp ); + webbur::dif_to_r8poly ( nd, xd, yd, c ); + a_value = webbur::r8poly_ant_val ( n, c, a ); + b_value = webbur::r8poly_ant_val ( n, c, b ); + w[k] = b_value - a_value; + y[i] = 0.0; + k = k + 1; + + yp[i] = 1.0; + webbur::hermite_interpolant ( n, x, y, yp, xd, yd, xdp, ydp ); + webbur::dif_to_r8poly ( nd, xd, yd, c ); + a_value = webbur::r8poly_ant_val ( n, c, a ); + b_value = webbur::r8poly_ant_val ( n, c, b ); + w[k] = b_value - a_value; + yp[i] = 0.0; + k = k + 1; + } + + delete [] c; + delete [] xd; + delete [] xdp; + delete [] y; + delete [] yd; + delete [] ydp; + delete [] yp; + + return; +} +//****************************************************************************80 + +void hermite_interpolant_value ( int nd, double xd[], double yd[], double xdp[], + double ydp[], int nv, double xv[], double yv[], double yvp[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_INTERPOLANT_VALUE evaluates the Hermite interpolant polynomial. +// +// Discussion: +// +// In fact, this function will evaluate an arbitrary polynomial that is +// represented by a difference table. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 October 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Carl deBoor, +// A Practical Guide to Splines, +// Springer, 2001, +// ISBN: 0387953663, +// LC: QA1.A647.v27. +// +// Parameters: +// +// Input, int ND, the order of the difference table. +// +// Input, double XD[ND], YD[ND], the difference table for the +// interpolant value. +// +// Input, double XDP[ND-1], YDP[ND-1], the difference table for +// the interpolant derivative. +// +// Input, int NV, the number of evaluation points. +// +// Input, double XV[NV], the evaluation points. +// +// Output, double YV[NV], YVP[NV], the value of the interpolant and +// its derivative at the evaluation points. +// +{ + int i; + int j; + int ndp; + + ndp = nd - 1; + + for ( j = 0; j < nv; j++ ) + { + yv[j] = yd[nd-1]; + for ( i = nd - 2; 0 <= i; i-- ) + { + yv[j] = yd[i] + ( xv[j] - xd[i] ) * yv[j]; + } + + yvp[j] = ydp[ndp-1]; + for ( i = ndp - 2; 0 <= i; i-- ) + { + yvp[j] = ydp[i] + ( xv[j] - xdp[i] ) * yvp[j]; + } + } + return; +} +//****************************************************************************80 + +void hermite_lookup ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_LOOKUP looks up abscissas and weights for Gauss-Hermite quadrature. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 April 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Vladimir Krylov, +// Approximate Calculation of Integrals, +// Dover, 2006, +// ISBN: 0486445798. +// LC: QA311.K713. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Stephen Wolfram, +// The Mathematica Book, +// Fourth Edition, +// Cambridge University Press, 1999, +// ISBN: 0-521-64314-7, +// LC: QA76.95.W65. +// +// Daniel Zwillinger, editor, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, +// CRC Press, 1996, +// ISBN: 0-8493-2479-3, +// LC: QA47.M315. +// +// Parameters: +// +// Input, int N, the order. +// N must be between 1 and 20. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::hermite_lookup_points ( n, x ); + + webbur::hermite_lookup_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void hermite_lookup_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_LOOKUP_POINTS looks up abscissas for Hermite quadrature. +// +// Discussion: +// +// The integral: +// +// integral ( -oo < x < +oo ) exp ( - x * x ) * f(x) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ). +// +// Mathematica can numerically estimate the abscissas +// of order N to P digits by the command: +// +// NSolve [ HermiteH [ n, x ] == 0, x, p ] +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 April 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Vladimir Krylov, +// Approximate Calculation of Integrals, +// Dover, 2006, +// ISBN: 0486445798, +// LC: QA311.K713. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Stephen Wolfram, +// The Mathematica Book, +// Fourth Edition, +// Cambridge University Press, 1999, +// ISBN: 0-521-64314-7, +// LC: QA76.95.W65. +// +// Daniel Zwillinger, editor, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, +// CRC Press, 1996, +// ISBN: 0-8493-2479-3, +// LC: QA47.M315. +// +// Parameters: +// +// Input, int N, the order. +// N must be between 1 and 20. +// +// Output, double X[N], the abscissas. +// +{ + if ( n == 1 ) + { + x[0] = 0.0; + } + else if ( n == 2 ) + { + x[0] = - 0.707106781186547524400844362105E+00; + x[1] = 0.707106781186547524400844362105E+00; + } + else if ( n == 3 ) + { + x[0] = - 0.122474487139158904909864203735E+01; + x[1] = 0.0E+00; + x[2] = 0.122474487139158904909864203735E+01; + } + else if ( n == 4 ) + { + x[0] = - 0.165068012388578455588334111112E+01; + x[1] = - 0.524647623275290317884060253835E+00; + x[2] = 0.524647623275290317884060253835E+00; + x[3] = 0.165068012388578455588334111112E+01; + } + else if ( n == 5 ) + { + x[0] = - 0.202018287045608563292872408814E+01; + x[1] = - 0.958572464613818507112770593893E+00; + x[2] = 0.0E+00; + x[3] = 0.958572464613818507112770593893E+00; + x[4] = 0.202018287045608563292872408814E+01; + } + else if ( n == 6 ) + { + x[0] = - 0.235060497367449222283392198706E+01; + x[1] = - 0.133584907401369694971489528297E+01; + x[2] = - 0.436077411927616508679215948251E+00; + x[3] = 0.436077411927616508679215948251E+00; + x[4] = 0.133584907401369694971489528297E+01; + x[5] = 0.235060497367449222283392198706E+01; + } + else if ( n == 7 ) + { + x[0] = - 0.265196135683523349244708200652E+01; + x[1] = - 0.167355162876747144503180139830E+01; + x[2] = - 0.816287882858964663038710959027E+00; + x[3] = 0.0E+00; + x[4] = 0.816287882858964663038710959027E+00; + x[5] = 0.167355162876747144503180139830E+01; + x[6] = 0.265196135683523349244708200652E+01; + } + else if ( n == 8 ) + { + x[0] = - 0.293063742025724401922350270524E+01; + x[1] = - 0.198165675669584292585463063977E+01; + x[2] = - 0.115719371244678019472076577906E+01; + x[3] = - 0.381186990207322116854718885584E+00; + x[4] = 0.381186990207322116854718885584E+00; + x[5] = 0.115719371244678019472076577906E+01; + x[6] = 0.198165675669584292585463063977E+01; + x[7] = 0.293063742025724401922350270524E+01; + } + else if ( n == 9 ) + { + x[0] = - 0.319099320178152760723004779538E+01; + x[1] = - 0.226658058453184311180209693284E+01; + x[2] = - 0.146855328921666793166701573925E+01; + x[3] = - 0.723551018752837573322639864579E+00; + x[4] = 0.0E+00; + x[5] = 0.723551018752837573322639864579E+00; + x[6] = 0.146855328921666793166701573925E+01; + x[7] = 0.226658058453184311180209693284E+01; + x[8] = 0.319099320178152760723004779538E+01; + } + else if ( n == 10 ) + { + x[0] = - 0.343615911883773760332672549432E+01; + x[1] = - 0.253273167423278979640896079775E+01; + x[2] = - 0.175668364929988177345140122011E+01; + x[3] = - 0.103661082978951365417749191676E+01; + x[4] = - 0.342901327223704608789165025557E+00; + x[5] = 0.342901327223704608789165025557E+00; + x[6] = 0.103661082978951365417749191676E+01; + x[7] = 0.175668364929988177345140122011E+01; + x[8] = 0.253273167423278979640896079775E+01; + x[9] = 0.343615911883773760332672549432E+01; + } + else if ( n == 11 ) + { + x[0] = - 0.366847084655958251845837146485E+01; + x[1] = - 0.278329009978165177083671870152E+01; + x[2] = - 0.202594801582575533516591283121E+01; + x[3] = - 0.132655708449493285594973473558E+01; + x[4] = - 0.656809566882099765024611575383E+00; + x[5] = 0.0E+00; + x[6] = 0.656809566882099765024611575383E+00; + x[7] = 0.132655708449493285594973473558E+01; + x[8] = 0.202594801582575533516591283121E+01; + x[9] = 0.278329009978165177083671870152E+01; + x[10] = 0.366847084655958251845837146485E+01; + } + else if ( n == 12 ) + { + x[0] = - 0.388972489786978191927164274724E+01; + x[1] = - 0.302063702512088977171067937518E+01; + x[2] = - 0.227950708050105990018772856942E+01; + x[3] = - 0.159768263515260479670966277090E+01; + x[4] = - 0.947788391240163743704578131060E+00; + x[5] = - 0.314240376254359111276611634095E+00; + x[6] = 0.314240376254359111276611634095E+00; + x[7] = 0.947788391240163743704578131060E+00; + x[8] = 0.159768263515260479670966277090E+01; + x[9] = 0.227950708050105990018772856942E+01; + x[10] = 0.302063702512088977171067937518E+01; + x[11] = 0.388972489786978191927164274724E+01; + } + else if ( n == 13 ) + { + x[0] = - 0.410133759617863964117891508007E+01; + x[1] = - 0.324660897837240998812205115236E+01; + x[2] = - 0.251973568567823788343040913628E+01; + x[3] = - 0.185310765160151214200350644316E+01; + x[4] = - 0.122005503659074842622205526637E+01; + x[5] = - 0.605763879171060113080537108602E+00; + x[6] = 0.0E+00; + x[7] = 0.605763879171060113080537108602E+00; + x[8] = 0.122005503659074842622205526637E+01; + x[9] = 0.185310765160151214200350644316E+01; + x[10] = 0.251973568567823788343040913628E+01; + x[11] = 0.324660897837240998812205115236E+01; + x[12] = 0.410133759617863964117891508007E+01; + } + else if ( n == 14 ) + { + x[0] = - 0.430444857047363181262129810037E+01; + x[1] = - 0.346265693360227055020891736115E+01; + x[2] = - 0.274847072498540256862499852415E+01; + x[3] = - 0.209518325850771681573497272630E+01; + x[4] = - 0.147668273114114087058350654421E+01; + x[5] = - 0.878713787329399416114679311861E+00; + x[6] = - 0.291745510672562078446113075799E+00; + x[7] = 0.291745510672562078446113075799E+00; + x[8] = 0.878713787329399416114679311861E+00; + x[9] = 0.147668273114114087058350654421E+01; + x[10] = 0.209518325850771681573497272630E+01; + x[11] = 0.274847072498540256862499852415E+01; + x[12] = 0.346265693360227055020891736115E+01; + x[13] = 0.430444857047363181262129810037E+01; + } + else if ( n == 15 ) + { + x[0] = - 0.449999070730939155366438053053E+01; + x[1] = - 0.366995037340445253472922383312E+01; + x[2] = - 0.296716692790560324848896036355E+01; + x[3] = - 0.232573248617385774545404479449E+01; + x[4] = - 0.171999257518648893241583152515E+01; + x[5] = - 0.113611558521092066631913490556E+01; + x[6] = - 0.565069583255575748526020337198E+00; + x[7] = 0.0E+00; + x[8] = 0.565069583255575748526020337198E+00; + x[9] = 0.113611558521092066631913490556E+01; + x[10] = 0.171999257518648893241583152515E+01; + x[11] = 0.232573248617385774545404479449E+01; + x[12] = 0.296716692790560324848896036355E+01; + x[13] = 0.366995037340445253472922383312E+01; + x[14] = 0.449999070730939155366438053053E+01; + } + else if ( n == 16 ) + { + x[0] = - 0.468873893930581836468849864875E+01; + x[1] = - 0.386944790486012269871942409801E+01; + x[2] = - 0.317699916197995602681399455926E+01; + x[3] = - 0.254620215784748136215932870545E+01; + x[4] = - 0.195178799091625397743465541496E+01; + x[5] = - 0.138025853919888079637208966969E+01; + x[6] = - 0.822951449144655892582454496734E+00; + x[7] = - 0.273481046138152452158280401965E+00; + x[8] = 0.273481046138152452158280401965E+00; + x[9] = 0.822951449144655892582454496734E+00; + x[10] = 0.138025853919888079637208966969E+01; + x[11] = 0.195178799091625397743465541496E+01; + x[12] = 0.254620215784748136215932870545E+01; + x[13] = 0.317699916197995602681399455926E+01; + x[14] = 0.386944790486012269871942409801E+01; + x[15] = 0.468873893930581836468849864875E+01; + } + else if ( n == 17 ) + { + x[0] = - 0.487134519367440308834927655662E+01; + x[1] = - 0.406194667587547430689245559698E+01; + x[2] = - 0.337893209114149408338327069289E+01; + x[3] = - 0.275776291570388873092640349574E+01; + x[4] = - 0.217350282666662081927537907149E+01; + x[5] = - 0.161292431422123133311288254454E+01; + x[6] = - 0.106764872574345055363045773799E+01; + x[7] = - 0.531633001342654731349086553718E+00; + x[8] = 0.0E+00; + x[9] = 0.531633001342654731349086553718E+00; + x[10] = 0.106764872574345055363045773799E+01; + x[11] = 0.161292431422123133311288254454E+01; + x[12] = 0.217350282666662081927537907149E+01; + x[13] = 0.275776291570388873092640349574E+01; + x[14] = 0.337893209114149408338327069289E+01; + x[15] = 0.406194667587547430689245559698E+01; + x[16] = 0.487134519367440308834927655662E+01; + } + else if ( n == 18 ) + { + x[0] = - 0.504836400887446676837203757885E+01; + x[1] = - 0.424811787356812646302342016090E+01; + x[2] = - 0.357376906848626607950067599377E+01; + x[3] = - 0.296137750553160684477863254906E+01; + x[4] = - 0.238629908916668600026459301424E+01; + x[5] = - 0.183553160426162889225383944409E+01; + x[6] = - 0.130092085838961736566626555439E+01; + x[7] = - 0.776682919267411661316659462284E+00; + x[8] = - 0.258267750519096759258116098711E+00; + x[9] = 0.258267750519096759258116098711E+00; + x[10] = 0.776682919267411661316659462284E+00; + x[11] = 0.130092085838961736566626555439E+01; + x[12] = 0.183553160426162889225383944409E+01; + x[13] = 0.238629908916668600026459301424E+01; + x[14] = 0.296137750553160684477863254906E+01; + x[15] = 0.357376906848626607950067599377E+01; + x[16] = 0.424811787356812646302342016090E+01; + x[17] = 0.504836400887446676837203757885E+01; + } + else if ( n == 19 ) + { + x[0] = - 0.522027169053748216460967142500E+01; + x[1] = - 0.442853280660377943723498532226E+01; + x[2] = - 0.376218735196402009751489394104E+01; + x[3] = - 0.315784881834760228184318034120E+01; + x[4] = - 0.259113378979454256492128084112E+01; + x[5] = - 0.204923170985061937575050838669E+01; + x[6] = - 0.152417061939353303183354859367E+01; + x[7] = - 0.101036838713431135136859873726E+01; + x[8] = - 0.503520163423888209373811765050E+00; + x[9] = 0.0E+00; + x[10] = 0.503520163423888209373811765050E+00; + x[11] = 0.101036838713431135136859873726E+01; + x[12] = 0.152417061939353303183354859367E+01; + x[13] = 0.204923170985061937575050838669E+01; + x[14] = 0.259113378979454256492128084112E+01; + x[15] = 0.315784881834760228184318034120E+01; + x[16] = 0.376218735196402009751489394104E+01; + x[17] = 0.442853280660377943723498532226E+01; + x[18] = 0.522027169053748216460967142500E+01; + } + else if ( n == 20 ) + { + x[0] = - 0.538748089001123286201690041068E+01; + x[1] = - 0.460368244955074427307767524898E+01; + x[2] = - 0.394476404011562521037562880052E+01; + x[3] = - 0.334785456738321632691492452300E+01; + x[4] = - 0.278880605842813048052503375640E+01; + x[5] = - 0.225497400208927552308233334473E+01; + x[6] = - 0.173853771211658620678086566214E+01; + x[7] = - 0.123407621539532300788581834696E+01; + x[8] = - 0.737473728545394358705605144252E+00; + x[9] = - 0.245340708300901249903836530634E+00; + x[10] = 0.245340708300901249903836530634E+00; + x[11] = 0.737473728545394358705605144252E+00; + x[12] = 0.123407621539532300788581834696E+01; + x[13] = 0.173853771211658620678086566214E+01; + x[14] = 0.225497400208927552308233334473E+01; + x[15] = 0.278880605842813048052503375640E+01; + x[16] = 0.334785456738321632691492452300E+01; + x[17] = 0.394476404011562521037562880052E+01; + x[18] = 0.460368244955074427307767524898E+01; + x[19] = 0.538748089001123286201690041068E+01; + } + else + { + std::cerr << "\n"; + std::cerr << "HERMITE_LOOKUP_POINTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::cerr << " Legal values are 1 through 20.\n"; + std::exit ( 1 ); + } + + return; +} +//****************************************************************************80 + +void hermite_lookup_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_LOOKUP_WEIGHTS looks up weights for Hermite quadrature. +// +// Discussion: +// +// The integral: +// +// integral ( -oo < x < +oo ) exp ( - x * x ) * f(x) dx +// +// The quadrature rule: +// +// sum ( 1 <= i <= n ) w(i) * f ( x(i) ). +// +// Mathematica can numerically estimate the abscissas +// of order N to P digits by the command: +// +// NSolve [ HermiteH [ n, x ] == 0, x, p ] +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 April 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Vladimir Krylov, +// Approximate Calculation of Integrals, +// Dover, 2006, +// ISBN: 0486445798, +// LC: QA311.K713. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Stephen Wolfram, +// The Mathematica Book, +// Fourth Edition, +// Cambridge University Press, 1999, +// ISBN: 0-521-64314-7, +// LC: QA76.95.W65. +// +// Daniel Zwillinger, editor, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, +// CRC Press, 1996, +// ISBN: 0-8493-2479-3, +// LC: QA47.M315. +// +// Parameters: +// +// Input, int N, the order. +// N must be between 1 and 20. +// +// Output, double W[N], the weights. +// +{ + if ( n == 1 ) + { + w[0] = 1.77245385090551602729816748334; + } + else if ( n == 2 ) + { + w[0] = 0.886226925452758013649083741671E+00; + w[1] = 0.886226925452758013649083741671E+00; + } + else if ( n == 3 ) + { + w[0] = 0.295408975150919337883027913890E+00; + w[1] = 0.118163590060367735153211165556E+01; + w[2] = 0.295408975150919337883027913890E+00; + } + else if ( n == 4 ) + { + w[0] = 0.813128354472451771430345571899E-01; + w[1] = 0.804914090005512836506049184481E+00; + w[2] = 0.804914090005512836506049184481E+00; + w[3] = 0.813128354472451771430345571899E-01; + } + else if ( n == 5 ) + { + w[0] = 0.199532420590459132077434585942E-01; + w[1] = 0.393619323152241159828495620852E+00; + w[2] = 0.945308720482941881225689324449E+00; + w[3] = 0.393619323152241159828495620852E+00; + w[4] = 0.199532420590459132077434585942E-01; + } + else if ( n == 6 ) + { + w[0] = 0.453000990550884564085747256463E-02; + w[1] = 0.157067320322856643916311563508E+00; + w[2] = 0.724629595224392524091914705598E+00; + w[3] = 0.724629595224392524091914705598E+00; + w[4] = 0.157067320322856643916311563508E+00; + w[5] = 0.453000990550884564085747256463E-02; + } + else if ( n == 7 ) + { + w[0] = 0.971781245099519154149424255939E-03; + w[1] = 0.545155828191270305921785688417E-01; + w[2] = 0.425607252610127800520317466666E+00; + w[3] = 0.810264617556807326764876563813E+00; + w[4] = 0.425607252610127800520317466666E+00; + w[5] = 0.545155828191270305921785688417E-01; + w[6] = 0.971781245099519154149424255939E-03; + } + else if ( n == 8 ) + { + w[0] = 0.199604072211367619206090452544E-03; + w[1] = 0.170779830074134754562030564364E-01; + w[2] = 0.207802325814891879543258620286E+00; + w[3] = 0.661147012558241291030415974496E+00; + w[4] = 0.661147012558241291030415974496E+00; + w[5] = 0.207802325814891879543258620286E+00; + w[6] = 0.170779830074134754562030564364E-01; + w[7] = 0.199604072211367619206090452544E-03; + } + else if ( n == 9 ) + { + w[0] = 0.396069772632643819045862946425E-04; + w[1] = 0.494362427553694721722456597763E-02; + w[2] = 0.884745273943765732879751147476E-01; + w[3] = 0.432651559002555750199812112956E+00; + w[4] = 0.720235215606050957124334723389E+00; + w[5] = 0.432651559002555750199812112956E+00; + w[6] = 0.884745273943765732879751147476E-01; + w[7] = 0.494362427553694721722456597763E-02; + w[8] = 0.396069772632643819045862946425E-04; + } + else if ( n == 10 ) + { + w[0] = 0.764043285523262062915936785960E-05; + w[1] = 0.134364574678123269220156558585E-02; + w[2] = 0.338743944554810631361647312776E-01; + w[3] = 0.240138611082314686416523295006E+00; + w[4] = 0.610862633735325798783564990433E+00; + w[5] = 0.610862633735325798783564990433E+00; + w[6] = 0.240138611082314686416523295006E+00; + w[7] = 0.338743944554810631361647312776E-01; + w[8] = 0.134364574678123269220156558585E-02; + w[9] = 0.764043285523262062915936785960E-05; + } + else if ( n == 11 ) + { + w[0] = 0.143956039371425822033088366032E-05; + w[1] = 0.346819466323345510643413772940E-03; + w[2] = 0.119113954449115324503874202916E-01; + w[3] = 0.117227875167708503381788649308E+00; + w[4] = 0.429359752356125028446073598601E+00; + w[5] = 0.654759286914591779203940657627E+00; + w[6] = 0.429359752356125028446073598601E+00; + w[7] = 0.117227875167708503381788649308E+00; + w[8] = 0.119113954449115324503874202916E-01; + w[9] = 0.346819466323345510643413772940E-03; + w[10] = 0.143956039371425822033088366032E-05; + } + else if ( n == 12 ) + { + w[0] = 0.265855168435630160602311400877E-06; + w[1] = 0.857368704358785865456906323153E-04; + w[2] = 0.390539058462906185999438432620E-02; + w[3] = 0.516079856158839299918734423606E-01; + w[4] = 0.260492310264161129233396139765E+00; + w[5] = 0.570135236262479578347113482275E+00; + w[6] = 0.570135236262479578347113482275E+00; + w[7] = 0.260492310264161129233396139765E+00; + w[8] = 0.516079856158839299918734423606E-01; + w[9] = 0.390539058462906185999438432620E-02; + w[10] = 0.857368704358785865456906323153E-04; + w[11] = 0.265855168435630160602311400877E-06; + } + else if ( n == 13 ) + { + w[0] = 0.482573185007313108834997332342E-07; + w[1] = 0.204303604027070731248669432937E-04; + w[2] = 0.120745999271938594730924899224E-02; + w[3] = 0.208627752961699392166033805050E-01; + w[4] = 0.140323320687023437762792268873E+00; + w[5] = 0.421616296898543221746893558568E+00; + w[6] = 0.604393187921161642342099068579E+00; + w[7] = 0.421616296898543221746893558568E+00; + w[8] = 0.140323320687023437762792268873E+00; + w[9] = 0.208627752961699392166033805050E-01; + w[10] = 0.120745999271938594730924899224E-02; + w[11] = 0.204303604027070731248669432937E-04; + w[12] = 0.482573185007313108834997332342E-07; + } + else if ( n == 14 ) + { + w[0] = 0.862859116812515794532041783429E-08; + w[1] = 0.471648435501891674887688950105E-05; + w[2] = 0.355092613551923610483661076691E-03; + w[3] = 0.785005472645794431048644334608E-02; + w[4] = 0.685055342234652055387163312367E-01; + w[5] = 0.273105609064246603352569187026E+00; + w[6] = 0.536405909712090149794921296776E+00; + w[7] = 0.536405909712090149794921296776E+00; + w[8] = 0.273105609064246603352569187026E+00; + w[9] = 0.685055342234652055387163312367E-01; + w[10] = 0.785005472645794431048644334608E-02; + w[11] = 0.355092613551923610483661076691E-03; + w[12] = 0.471648435501891674887688950105E-05; + w[13] = 0.862859116812515794532041783429E-08; + } + else if ( n == 15 ) + { + w[0] = 0.152247580425351702016062666965E-08; + w[1] = 0.105911554771106663577520791055E-05; + w[2] = 0.100004441232499868127296736177E-03; + w[3] = 0.277806884291277589607887049229E-02; + w[4] = 0.307800338725460822286814158758E-01; + w[5] = 0.158488915795935746883839384960E+00; + w[6] = 0.412028687498898627025891079568E+00; + w[7] = 0.564100308726417532852625797340E+00; + w[8] = 0.412028687498898627025891079568E+00; + w[9] = 0.158488915795935746883839384960E+00; + w[10] = 0.307800338725460822286814158758E-01; + w[11] = 0.277806884291277589607887049229E-02; + w[12] = 0.100004441232499868127296736177E-03; + w[13] = 0.105911554771106663577520791055E-05; + w[14] = 0.152247580425351702016062666965E-08; + } + else if ( n == 16 ) + { + w[0] = 0.265480747401118224470926366050E-09; + w[1] = 0.232098084486521065338749423185E-06; + w[2] = 0.271186009253788151201891432244E-04; + w[3] = 0.932284008624180529914277305537E-03; + w[4] = 0.128803115355099736834642999312E-01; + w[5] = 0.838100413989858294154207349001E-01; + w[6] = 0.280647458528533675369463335380E+00; + w[7] = 0.507929479016613741913517341791E+00; + w[8] = 0.507929479016613741913517341791E+00; + w[9] = 0.280647458528533675369463335380E+00; + w[10] = 0.838100413989858294154207349001E-01; + w[11] = 0.128803115355099736834642999312E-01; + w[12] = 0.932284008624180529914277305537E-03; + w[13] = 0.271186009253788151201891432244E-04; + w[14] = 0.232098084486521065338749423185E-06; + w[15] = 0.265480747401118224470926366050E-09; + } + else if ( n == 17 ) + { + w[0] = 0.458057893079863330580889281222E-10; + w[1] = 0.497707898163079405227863353715E-07; + w[2] = 0.711228914002130958353327376218E-05; + w[3] = 0.298643286697753041151336643059E-03; + w[4] = 0.506734995762753791170069495879E-02; + w[5] = 0.409200341495762798094994877854E-01; + w[6] = 0.172648297670097079217645196219E+00; + w[7] = 0.401826469470411956577635085257E+00; + w[8] = 0.530917937624863560331883103379E+00; + w[9] = 0.401826469470411956577635085257E+00; + w[10] = 0.172648297670097079217645196219E+00; + w[11] = 0.409200341495762798094994877854E-01; + w[12] = 0.506734995762753791170069495879E-02; + w[13] = 0.298643286697753041151336643059E-03; + w[14] = 0.711228914002130958353327376218E-05; + w[15] = 0.497707898163079405227863353715E-07; + w[16] = 0.458057893079863330580889281222E-10; + } + else if ( n == 18 ) + { + w[0] = 0.782819977211589102925147471012E-11; + w[1] = 0.104672057957920824443559608435E-07; + w[2] = 0.181065448109343040959702385911E-05; + w[3] = 0.918112686792940352914675407371E-04; + w[4] = 0.188852263026841789438175325426E-02; + w[5] = 0.186400423875446519219315221973E-01; + w[6] = 0.973017476413154293308537234155E-01; + w[7] = 0.284807285669979578595606820713E+00; + w[8] = 0.483495694725455552876410522141E+00; + w[9] = 0.483495694725455552876410522141E+00; + w[10] = 0.284807285669979578595606820713E+00; + w[11] = 0.973017476413154293308537234155E-01; + w[12] = 0.186400423875446519219315221973E-01; + w[13] = 0.188852263026841789438175325426E-02; + w[14] = 0.918112686792940352914675407371E-04; + w[15] = 0.181065448109343040959702385911E-05; + w[16] = 0.104672057957920824443559608435E-07; + w[17] = 0.782819977211589102925147471012E-11; + } + else if ( n == 19 ) + { + w[0] = 0.132629709449851575185289154385E-11; + w[1] = 0.216305100986355475019693077221E-08; + w[2] = 0.448824314722312295179447915594E-06; + w[3] = 0.272091977631616257711941025214E-04; + w[4] = 0.670877521407181106194696282100E-03; + w[5] = 0.798886677772299020922211491861E-02; + w[6] = 0.508103869090520673569908110358E-01; + w[7] = 0.183632701306997074156148485766E+00; + w[8] = 0.391608988613030244504042313621E+00; + w[9] = 0.502974888276186530840731361096E+00; + w[10] = 0.391608988613030244504042313621E+00; + w[11] = 0.183632701306997074156148485766E+00; + w[12] = 0.508103869090520673569908110358E-01; + w[13] = 0.798886677772299020922211491861E-02; + w[14] = 0.670877521407181106194696282100E-03; + w[15] = 0.272091977631616257711941025214E-04; + w[16] = 0.448824314722312295179447915594E-06; + w[17] = 0.216305100986355475019693077221E-08; + w[18] = 0.132629709449851575185289154385E-11; + } + else if ( n == 20 ) + { + w[0] = 0.222939364553415129252250061603E-12; + w[1] = 0.439934099227318055362885145547E-09; + w[2] = 0.108606937076928169399952456345E-06; + w[3] = 0.780255647853206369414599199965E-05; + w[4] = 0.228338636016353967257145917963E-03; + w[5] = 0.324377334223786183218324713235E-02; + w[6] = 0.248105208874636108821649525589E-01; + w[7] = 0.109017206020023320013755033535E+00; + w[8] = 0.286675505362834129719659706228E+00; + w[9] = 0.462243669600610089650328639861E+00; + w[10] = 0.462243669600610089650328639861E+00; + w[11] = 0.286675505362834129719659706228E+00; + w[12] = 0.109017206020023320013755033535E+00; + w[13] = 0.248105208874636108821649525589E-01; + w[14] = 0.324377334223786183218324713235E-02; + w[15] = 0.228338636016353967257145917963E-03; + w[16] = 0.780255647853206369414599199965E-05; + w[17] = 0.108606937076928169399952456345E-06; + w[18] = 0.439934099227318055362885145547E-09; + w[19] = 0.222939364553415129252250061603E-12; + } + else + { + std::cerr << "\n"; + std::cerr << "HERMITE_LOOKUP_WEIGHTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::cerr << " Legal values are 1 through 20.\n"; + std::exit ( 1 ); + } + + return; +} +//****************************************************************************80 + +void hermite_ss_compute ( int order, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_SS_COMPUTE computes a Hermite quadrature rule. +// +// Discussion: +// +// The abscissas are the zeros of the N-th order Hermite polynomial. +// +// The integral: +// +// Integral ( -oo < X < +oo ) exp ( - X * X ) * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double cc; + double dp2; + int i; + double p1; + double s; + double temp; + double x0; + + if ( order < 1 ) + { + std::cerr << "\n"; + std::cerr << "HERMITE_SS_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of ORDER = " << order << "\n"; + std::exit ( 1 ); + } + + cc = 1.7724538509 * webbur::r8_gamma ( ( double ) ( order ) ) + / std::pow ( 2.0, order - 1 ); + + s = std::pow ( 2.0 * ( double ) ( order ) + 1.0, 1.0 / 6.0 ); + + for ( i = 0; i < ( order + 1 ) / 2; i++ ) + { + if ( i == 0 ) + { + x0 = s * s * s - 1.85575 / s; + } + else if ( i == 1 ) + { + x0 = x0 - 1.14 * std::pow ( ( double ) ( order ), 0.426 ) / x0; + } + else if ( i == 2 ) + { + x0 = 1.86 * x0 - 0.86 * x[0]; + } + else if ( i == 3 ) + { + x0 = 1.91 * x0 - 0.91 * x[1]; + } + else + { + x0 = 2.0 * x0 - x[i-2]; + } + + webbur::hermite_ss_root ( &x0, order, &dp2, &p1 ); + + x[i] = x0; + w[i] = ( cc / dp2 ) / p1; + + x[order-i-1] = -x0; + w[order-i-1] = w[i]; + } +// +// Reverse the order of the abscissas. +// + for ( i = 1; i <= order/2; i++ ) + { + temp = x[i-1]; + x[i-1] = x[order-i]; + x[order-i] = temp; + } + + if ( ( order % 2 ) == 1 ) + { + x[(order-1)/2] = 0.0; + } + + return; +} +//****************************************************************************80 + +void hermite_ss_recur ( double *p2, double *dp2, double *p1, double x, int order ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_SS_RECUR finds the value and derivative of a Hermite polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Output, double *P2, the value of H(ORDER)(X). +// +// Output, double *DP2, the value of H'(ORDER)(X). +// +// Output, double *P1, the value of H(ORDER-1)(X). +// +// Input, double X, the point at which polynomials are evaluated. +// +// Input, int ORDER, the order of the polynomial. +// +{ + int i; + double dq0; + double dq1; + double dq2; + double q0; + double q1; + double q2; + + q1 = 1.0; + dq1 = 0.0; + + q2 = x; + dq2 = 1.0; + + for ( i = 2; i <= order; i++ ) + { + q0 = q1; + dq0 = dq1; + + q1 = q2; + dq1 = dq2; + + q2 = x * q1 - 0.5 * ( ( double ) ( i ) - 1.0 ) * q0; + dq2 = x * dq1 + q1 - 0.5 * ( ( double ) ( i ) - 1.0 ) * dq0; + } + + *p2 = q2; + *dp2 = dq2; + *p1 = q1; + + return; +} +//****************************************************************************80 + +void hermite_ss_root ( double *x, int order, double *dp2, double *p1 ) + +//****************************************************************************80 +// +// Purpose: +// +// HERMITE_SS_ROOT improves an approximate root of a Hermite polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input/output, double *X, the approximate root, which +// should be improved on output. +// +// Input, int ORDER, the order of the Hermite polynomial. +// +// Output, double *DP2, the value of H'(ORDER)(X). +// +// Output, double *P1, the value of H(ORDER-1)(X). +// +{ + double d; + double eps; + double p2; + int step; + int step_max = 10; + + eps = webbur::r8_epsilon ( ); + + for ( step = 1; step <= step_max; step++ ) + { + webbur::hermite_ss_recur ( &p2, dp2, p1, *x, order ); + + d = p2 / ( *dp2 ); + *x = *x - d; + + if ( webbur::r8_abs ( d ) <= eps * ( webbur::r8_abs ( *x ) + 1.0 ) ) + { + return; + } + } + return; +} +//****************************************************************************80 + +int i4_choose ( int n, int k ) + +//****************************************************************************80 +// +// Purpose: +// +// I4_CHOOSE computes the binomial coefficient C(N,K). +// +// Discussion: +// +// The value is calculated in such a way as to avoid overflow and +// roundoff. The calculation is done in integer arithmetic. +// +// The formula used is: +// +// C(N,K) = N! / ( K! * (N-K)! ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 09 November 2007 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// ML Wolfson, HV Wright, +// Algorithm 160: +// Combinatorial of M Things Taken N at a Time, +// Communications of the ACM, +// Volume 6, Number 4, April 1963, page 161. +// +// Parameters: +// +// Input, int N, K, the values of N and K. +// +// Output, int I4_CHOOSE, the number of combinations of N +// things taken K at a time. +// +{ + int i; + int mn; + int mx; + int value; + + mn = i4_min ( k, n - k ); + + if ( mn < 0 ) + { + value = 0; + } + else if ( mn == 0 ) + { + value = 1; + } + else + { + mx = i4_max ( k, n - k ); + value = mx + 1; + + for ( i = 2; i <= mn; i++ ) + { + value = ( value * ( mx + i ) ) / i; + } + } + + return value; +} +//****************************************************************************80 + +int i4_log_2 ( int i ) + +//****************************************************************************80 +// +// Purpose: +// +// I4_LOG_2 returns the integer part of the logarithm base 2 of an I4. +// +// Example: +// +// I I4_LOG_10 +// ----- -------- +// 0 0 +// 1 0 +// 2 1 +// 3 1 +// 4 2 +// 5 2 +// 7 2 +// 8 3 +// 9 3 +// 1000 9 +// 1024 10 +// +// Discussion: +// +// I4_LOG_2 ( I ) + 1 is the number of binary digits in I. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 04 January 2004 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int I, the number whose logarithm base 2 is desired. +// +// Output, int I4_LOG_2, the integer part of the logarithm base 2 of +// the absolute value of X. +// +{ + int i_abs; + int two_pow; + int value; + + if ( i == 0 ) + { + value = 0; + } + else + { + value = 0; + two_pow = 2; + + i_abs = std::abs ( i ); + + while ( two_pow <= i_abs ) + { + value = value + 1; + two_pow = two_pow * 2; + } + } + + return value; +} +//****************************************************************************80 + +int i4_max ( int i1, int i2 ) + +//****************************************************************************80 +// +// Purpose: +// +// I4_MAX returns the maximum of two I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 October 1998 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int I1, I2, are two integers to be compared. +// +// Output, int I4_MAX, the larger of I1 and I2. +// +{ + int value; + + if ( i2 < i1 ) + { + value = i1; + } + else + { + value = i2; + } + return value; +} +//****************************************************************************80 + +int i4_min ( int i1, int i2 ) + +//****************************************************************************80 +// +// Purpose: +// +// I4_MIN returns the minimum of two I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 October 1998 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int I1, I2, two integers to be compared. +// +// Output, int I4_MIN, the smaller of I1 and I2. +// +{ + int value; + + if ( i1 < i2 ) + { + value = i1; + } + else + { + value = i2; + } + return value; +} +//****************************************************************************80 + +int i4_power ( int i, int j ) + +//****************************************************************************80 +// +// Purpose: +// +// I4_POWER returns the value of I^J. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 01 April 2004 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int I, J, the base and the power. J should be nonnegative. +// +// Output, int I4_POWER, the value of I^J. +// +{ + int k; + int value; + + if ( j < 0 ) + { + if ( i == 1 ) + { + value = 1; + } + else if ( i == 0 ) + { + std::cerr << "\n"; + std::cerr << "I4_POWER - Fatal error!\n"; + std::cerr << " I^J requested, with I = 0 and J negative.\n"; + std::exit ( 1 ); + } + else + { + value = 0; + } + } + else if ( j == 0 ) + { + if ( i == 0 ) + { + std::cerr << "\n"; + std::cerr << "I4_POWER - Fatal error!\n"; + std::cerr << " I^J requested, with I = 0 and J = 0.\n"; + std::exit ( 1 ); + } + else + { + value = 1; + } + } + else if ( j == 1 ) + { + value = i; + } + else + { + value = 1; + for ( k = 1; k <= j; k++ ) + { + value = value * i; + } + } + return value; +} +//****************************************************************************80 + +void i4mat_copy ( int m, int n, int a1[], int a2[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4MAT_COPY copies one I4MAT to another. +// +// Discussion: +// +// An I4MAT is an MxN array of I4's, stored by (I,J) -> [I+J*M]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 August 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns. +// +// Input, int A1[M*N], the matrix to be copied. +// +// Output, int A2[M*N], the copy of A1. +// +{ + int i; + int j; + + for ( j = 0; j < n; j++ ) + { + for ( i = 0; i < m; i++ ) + { + a2[i+j*m] = a1[i+j*m]; + } + } + return; +} +//****************************************************************************80 + +int *i4mat_copy_new ( int m, int n, int a1[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4MAT_COPY_NEW copies an I4MAT to a "new" I4MAT. +// +// Discussion: +// +// An I4MAT is an MxN array of I4's, stored by (I,J) -> [I+J*M]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 August 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns. +// +// Input, int A1[M*N], the matrix to be copied. +// +// Output, int I4MAT_COPY_NEW[M*N], the copy of A1. +// +{ + int *a2; + int i; + int j; + + a2 = new int[m*n]; + + for ( j = 0; j < n; j++ ) + { + for ( i = 0; i < m; i++ ) + { + a2[i+j*m] = a1[i+j*m]; + } + } + return a2; +} +//****************************************************************************80 + +void i4mat_transpose_print ( int m, int n, int a[], std::string title ) + +//****************************************************************************80 +// +// Purpose: +// +// I4MAT_TRANSPOSE_PRINT prints an I4MAT, transposed. +// +// Discussion: +// +// An I4MAT is an MxN array of I4's, stored by (I,J) -> [I+J*M]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 January 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows in A. +// +// Input, int N, the number of columns in A. +// +// Input, int A[M*N], the M by N matrix. +// +// Input, string TITLE, a title. +// +{ + i4mat_transpose_print_some ( m, n, a, 1, 1, m, n, title ); + + return; +} +//****************************************************************************80 + +void i4mat_transpose_print_some ( int m, int n, int a[], int ilo, int jlo, + int ihi, int jhi, std::string title ) + +//****************************************************************************80 +// +// Purpose: +// +// I4MAT_TRANSPOSE_PRINT_SOME prints some of an I4MAT, transposed. +// +// Discussion: +// +// An I4MAT is an MxN array of I4's, stored by (I,J) -> [I+J*M]. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 14 June 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows of the matrix. +// M must be positive. +// +// Input, int N, the number of columns of the matrix. +// N must be positive. +// +// Input, int A[M*N], the matrix. +// +// Input, int ILO, JLO, IHI, JHI, designate the first row and +// column, and the last row and column to be printed. +// +// Input, string TITLE, a title. +// +{ +# define INCX 10 + + int i; + int i2hi; + int i2lo; + int j; + int j2hi; + int j2lo; + + std::cout << "\n"; + std::cout << title << "\n"; +// +// Print the columns of the matrix, in strips of INCX. +// + for ( i2lo = ilo; i2lo <= ihi; i2lo = i2lo + INCX ) + { + i2hi = i2lo + INCX - 1; + i2hi = webbur::i4_min ( i2hi, m ); + i2hi = webbur::i4_min ( i2hi, ihi ); + + std::cout << "\n"; +// +// For each row I in the current range... +// +// Write the header. +// + std::cout << " Row: "; + for ( i = i2lo; i <= i2hi; i++ ) + { + std::cout << std::setw(6) << i - 1 << " "; + } + std::cout << "\n"; + std::cout << " Col\n"; + std::cout << "\n"; +// +// Determine the range of the rows in this strip. +// + j2lo = webbur::i4_max ( jlo, 1 ); + j2hi = webbur::i4_min ( jhi, n ); + + for ( j = j2lo; j <= j2hi; j++ ) + { +// +// Print out (up to INCX) entries in column J, that lie in the current strip. +// + std::cout << std::setw(5) << j - 1 << ":"; + for ( i = i2lo; i <= i2hi; i++ ) + { + std::cout << std::setw(6) << a[i-1+(j-1)*m] << " "; + } + std::cout << "\n"; + } + } + + return; +# undef INCX +} +//****************************************************************************80 + +void i4mat_write ( std::string output_filename, int m, int n, int table[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4MAT_WRITE writes an I4MAT file. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 01 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, string OUTPUT_FILENAME, the output filename. +// +// Input, int M, the spatial dimension. +// +// Input, int N, the number of points. +// +// Input, int TABLE[M*N], the table data. +// +{ + int i; + int j; + std::ofstream output; +// +// Open the file. +// + output.open ( output_filename.c_str ( ) ); + + if ( !output ) + { + std::cerr << "\n"; + std::cerr << "I4MAT_WRITE - Fatal error!\n"; + std::cerr << " Could not open the output file.\n"; + return; + } +// +// Write the data. +// + for ( j = 0; j < n; j++ ) + { + for ( i = 0; i < m; i++ ) + { + output << std::setw(10) << table[i+j*m] << " "; + } + output << "\n"; + } +// +// Close the file. +// + output.close ( ); + + return; +} +//****************************************************************************80 + +int *i4vec_add_new ( int n, int a[], int b[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_ADD_NEW computes C = A + B for I4VEC's. +// +// Discussion: +// +// An I4VEC is a vector of I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 28 April 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries. +// +// Input, int A[N], the first vector. +// +// Input, int B[N], the second vector. +// +// Output, int I4VEC_ADD_NEW[N], the sum of the vectors. +// +{ + int *c; + int i; + + c = new int[n]; + + for ( i = 0; i < n; i++ ) + { + c[i] = a[i] + b[i]; + } + return c; +} +//****************************************************************************80 + +bool i4vec_any_lt ( int n, int a[], int b[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_ANY_LT: ( any ( A < B ) ) for I4VEC's. +// +// Discussion: +// +// An I4VEC is a vector of I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 28 April 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries. +// +// Input, int A[N], the first vector. +// +// Input, int B[N], the second vector. +// +// Output, bool I4VEC_ANY_LT is TRUE if any entry +// of A is less than the corresponding entry of B. +// +{ + int i; + bool value; + + for ( i = 0; i < n; i++ ) + { + if ( a[i] < b[i] ) + { + value = true; + return value; + } + } + value = false; + + return value; +} +//****************************************************************************80 + +void i4vec_copy ( int n, int a1[], int a2[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_COPY copies an I4VEC. +// +// Discussion: +// +// An I4VEC is a vector of I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 25 April 2007 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vectors. +// +// Input, int A1[N], the vector to be copied. +// +// Output, int A2[N], the copy of A1. +// +{ + int i; + + for ( i = 0; i < n; i++ ) + { + a2[i] = a1[i]; + } + return; +} +//****************************************************************************80 + +int *i4vec_copy_new ( int n, int a1[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_COPY_NEW copies an I4VEC to a "new" I4VEC. +// +// Discussion: +// +// An I4VEC is a vector of I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 04 July 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vectors. +// +// Input, int A1[N], the vector to be copied. +// +// Output, int I4VEC_COPY_NEW[N], the copy of A1. +// +{ + int *a2; + int i; + + a2 = new int[n]; + + for ( i = 0; i < n; i++ ) + { + a2[i] = a1[i]; + } + return a2; +} +//****************************************************************************80 + +void i4vec_min_mv ( int m, int n, int u[], int v[], int w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_MIN_MV determines U(1:N) /\ V for vectors U and a single vector V. +// +// Discussion: +// +// For two vectors U and V, each of length M, we define +// +// ( U /\ V ) (I) = min ( U(I), V(I) ). +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 12 January 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the dimension of the vectors. +// +// Input, int N, the number of vectors in U. +// +// Input, int U[M*N], N vectors, each of length M. +// +// Input, int V[M], a vector of length M. +// +// Output, int W[M*N], the value of U /\ W. +// +{ + int i; + int j; + + for ( j = 0; j < n; j++ ) + { + for ( i = 0; i < m; i++ ) + { + w[i+j*m] = i4_min ( u[i+j*m], v[i] ); + } + } + return; +} +//****************************************************************************80 + +void i4vec_print ( int n, int a[], std::string title ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_PRINT prints an I4VEC. +// +// Discussion: +// +// An I4VEC is a vector of I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 14 November 2003 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of components of the vector. +// +// Input, int A[N], the vector to be printed. +// +// Input, string TITLE, a title. +// +{ + int i; + + std::cout << "\n"; + std::cout << title << "\n"; + std::cout << "\n"; + for ( i = 0; i < n; i++ ) + { + std::cout << " " << std::setw(8) << i + << ": " << std::setw(8) << a[i] << "\n"; + } + return; +} +//****************************************************************************80 + +int i4vec_product ( int n, int a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_PRODUCT multiplies the entries of an I4VEC. +// +// Discussion: +// +// An I4VEC is a vector of integer values. +// +// Example: +// +// Input: +// +// A = ( 1, 2, 3, 4 ) +// +// Output: +// +// I4VEC_PRODUCT = 24 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 May 2003 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Input, int A[N], the vector +// +// Output, int I4VEC_PRODUCT, the product of the entries of A. +// +{ + int i; + int product; + + product = 1; + for ( i = 0; i < n; i++ ) + { + product = product * a[i]; + } + + return product; +} +//****************************************************************************80 + +int i4vec_sum ( int n, int a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_SUM sums the entries of an I4VEC. +// +// Discussion: +// +// An I4VEC is a vector of I4's. +// +// Example: +// +// Input: +// +// A = ( 1, 2, 3, 4 ) +// +// Output: +// +// I4VEC_SUM = 10 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 04 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Input, int A[N], the vector to be summed. +// +// Output, int I4VEC_SUM, the sum of the entries of A. +// +{ + int i; + int sum; + + sum = 0; + for ( i = 0; i < n; i++ ) + { + sum = sum + a[i]; + } + + return sum; +} +//****************************************************************************80 + +void i4vec_zero ( int n, int a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_ZERO zeroes an I4VEC. +// +// Discussion: +// +// An I4VEC is a vector of I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 01 August 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Output, int A[N], a vector of zeroes. +// +{ + int i; + + for ( i = 0; i < n; i++ ) + { + a[i] = 0; + } + return; +} +//****************************************************************************80 + +int *i4vec_zero_new ( int n ) + +//****************************************************************************80 +// +// Purpose: +// +// I4VEC_ZERO_NEW creates and zeroes an I4VEC. +// +// Discussion: +// +// An I4VEC is a vector of I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 11 July 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Output, int I4VEC_ZERO_NEW[N], a vector of zeroes. +// +{ + int *a; + int i; + + a = new int[n]; + + for ( i = 0; i < n; i++ ) + { + a[i] = 0; + } + return a; +} +//****************************************************************************80 + +void imtqlx ( int n, double d[], double e[], double z[] ) + +//****************************************************************************80 +// +// Purpose: +// +// IMTQLX diagonalizes a symmetric tridiagonal matrix. +// +// Discussion: +// +// This routine is a slightly modified version of the EISPACK routine to +// perform the implicit QL algorithm on a symmetric tridiagonal matrix. +// +// The authors thank the authors of EISPACK for permission to use this +// routine. +// +// It has been modified to produce the product Q' * Z, where Z is an input +// vector and Q is the orthogonal matrix diagonalizing the input matrix. +// The changes consist (essentially) of applying the orthogonal transformations +// directly to Z as they are generated. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 08 January 2010 +// +// Author: +// +// Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky. +// C++ version by John Burkardt. +// +// Reference: +// +// Sylvan Elhay, Jaroslav Kautsky, +// Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of +// Interpolatory Quadrature, +// ACM Transactions on Mathematical Software, +// Volume 13, Number 4, December 1987, pages 399-415. +// +// Roger Martin, James Wilkinson, +// The Implicit QL Algorithm, +// Numerische Mathematik, +// Volume 12, Number 5, December 1968, pages 377-383. +// +// Parameters: +// +// Input, int N, the order of the matrix. +// +// Input/output, double D(N), the diagonal entries of the matrix. +// On output, the information in D has been overwritten. +// +// Input/output, double E(N), the subdiagonal entries of the +// matrix, in entries E(1) through E(N-1). On output, the information in +// E has been overwritten. +// +// Input/output, double Z(N). On input, a vector. On output, +// the value of Q' * Z, where Q is the matrix that diagonalizes the +// input symmetric tridiagonal matrix. +// +{ + double b; + double c; + double f; + double g; + int i; + int ii; + int itn = 30; + int j; + int k; + int l; + int m; + int mml; + double p; + double prec; + double r; + double s; + + prec = webbur::r8_epsilon ( ); + + if ( n == 1 ) + { + return; + } + + e[n-1] = 0.0; + + for ( l = 1; l <= n; l++ ) + { + j = 0; + for ( ; ; ) + { + for ( m = l; m <= n; m++ ) + { + if ( m == n ) + { + break; + } + + if ( webbur::r8_abs ( e[m-1] ) <= + prec * ( webbur::r8_abs ( d[m-1] ) + webbur::r8_abs ( d[m] ) ) ) + { + break; + } + } + p = d[l-1]; + if ( m == l ) + { + break; + } + if ( itn <= j ) + { + std::cerr << "\n"; + std::cerr << "IMTQLX - Fatal error!\n"; + std::cerr << " Iteration limit exceeded\n"; + std::exit ( 1 ); + } + j = j + 1; + g = ( d[l] - p ) / ( 2.0 * e[l-1] ); + r = std::sqrt ( g * g + 1.0 ); + g = d[m-1] - p + e[l-1] / ( g + webbur::r8_abs ( r ) * webbur::r8_sign ( g ) ); + s = 1.0; + c = 1.0; + p = 0.0; + mml = m - l; + + for ( ii = 1; ii <= mml; ii++ ) + { + i = m - ii; + f = s * e[i-1]; + b = c * e[i-1]; + + if ( webbur::r8_abs ( g ) <= webbur::r8_abs ( f ) ) + { + c = g / f; + r = std::sqrt ( c * c + 1.0 ); + e[i] = f * r; + s = 1.0 / r; + c = c * s; + } + else + { + s = f / g; + r = std::sqrt ( s * s + 1.0 ); + e[i] = g * r; + c = 1.0 / r; + s = s * c; + } + g = d[i] - p; + r = ( d[i-1] - g ) * s + 2.0 * c * b; + p = s * r; + d[i] = g + p; + g = c * r - b; + f = z[i]; + z[i] = s * z[i-1] + c * f; + z[i-1] = c * z[i-1] - s * f; + } + d[l-1] = d[l-1] - p; + e[l-1] = g; + e[m-1] = 0.0; + } + } +// +// Sorting. +// + for ( ii = 2; ii <= m; ii++ ) + { + i = ii - 1; + k = i; + p = d[i-1]; + + for ( j = ii; j <= n; j++ ) + { + if ( d[j-1] < p ) + { + k = j; + p = d[j-1]; + } + } + + if ( k != i ) + { + d[k-1] = d[i-1]; + d[i-1] = p; + p = z[i-1]; + z[i-1] = z[k-1]; + z[k-1] = p; + } + } + return; +} +//****************************************************************************80 + +void jacobi_compute ( int n, double alpha, double beta, double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_COMPUTE: Elhay-Kautsky method for Gauss-Jacobi quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) (1-X)**ALPHA * (1+X)**BETA * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) WEIGHT(I) * F ( XTAB(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 30 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky. +// C++ version by John Burkardt. +// +// Reference: +// +// Sylvan Elhay, Jaroslav Kautsky, +// Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of +// Interpolatory Quadrature, +// ACM Transactions on Mathematical Software, +// Volume 13, Number 4, December 1987, pages 399-415. +// +// Parameters: +// +// Input, int N, the order. +// +// Input, double ALPHA, BETA, the exponents of (1-X) and +// (1+X) in the quadrature rule. For simple Gauss-Legendre quadrature, +// set ALPHA = BETA = 0.0. -1.0 < ALPHA and -1.0 < BETA are required. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double abi; + double *bj; + int i; + double i_r8; + double zemu; +// +// Define the zero-th moment. +// + zemu = std::pow ( 2.0, alpha + beta + 1.0 ) + * webbur::r8_gamma ( alpha + 1.0 ) + * webbur::r8_gamma ( beta + 1.0 ) + / webbur::r8_gamma ( 2.0 + alpha + beta ); +// +// Define the Jacobi matrix. +// + bj = new double[n]; + + x[0] = ( beta - alpha ) / ( 2.0 + alpha + beta ); + + bj[0] = 4.0 * ( 1.0 + alpha ) * ( 1.0 + beta ) + / ( ( 3.0 + alpha + beta ) + * ( 2.0 + alpha + beta ) * ( 2.0 + alpha + beta ) ); + + for ( i = 1; i < n; i++ ) + { + i_r8 = ( double ) ( i + 1 ); + abi = 2.0 * i_r8 + alpha + beta; + x[i] = ( beta + alpha ) * ( beta - alpha ) / ( ( abi - 2.0 ) * abi ); + bj[i] = 4.0 * i_r8 * ( i_r8 + alpha ) * ( i_r8 + beta ) + * ( i_r8 + alpha + beta ) + / ( ( abi - 1.0 ) * ( abi + 1.0 ) * abi * abi ); + } + + for ( i = 0; i < n; i++ ) + { + bj[i] = std::sqrt ( bj[i] ); + } + + w[0] = std::sqrt ( zemu ); + + for ( i = 1; i < n; i++ ) + { + w[i] = 0.0; + } +// +// Diagonalize the Jacobi matrix. +// + webbur::imtqlx ( n, x, bj, w ); + + for ( i = 0; i < n; i++ ) + { + w[i] = w[i] * w[i]; + } + + delete [] bj; + + return; +} +//****************************************************************************80 + +void jacobi_compute_np ( int order, int np, double p[], double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_COMPUTE_NP computes a Jacobi quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) (1-X)^ALPHA * (1+X)^BETA * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// Thanks to Xu Xiang of Fudan University for pointing out that +// an earlier implementation of this routine was incorrect! +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameter values. +// P[0] = ALPHA, the exponent of (1-X) +// P[1] = BETA, the exponent of (1+X). +// -1.0 < ALPHA and -1.0 < BETA are required. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double alpha; + double beta; + + alpha = p[0]; + beta = p[1]; + + webbur::jacobi_compute ( order, alpha, beta, x, w ); + + return; +} +//****************************************************************************80 + +void jacobi_compute_points ( int order, double alpha, double beta, + double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_COMPUTE_POINTS computes Jacobi quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 14 October 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, double ALPHA, BETA, the exponents of the (1-X) and (1+X) factors. +// +// Output, double X[ORDER], the abscissas. +// +{ + double *w; + + w = new double[order]; + + webbur::jacobi_compute ( order, alpha, beta, x, w ); + + delete [] w; + + return; +} +//****************************************************************************80 + +void jacobi_compute_points_np ( int order, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_COMPUTE_POINTS_NP computes Jacobi quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameter values. +// P[0] = ALPHA, the exponent of (1-X) +// P[1] = BETA, the exponent of (1+X). +// -1.0 < ALPHA and -1.0 < BETA are required. +// +// Output, double X[ORDER], the abscissas. +// +{ + double alpha; + double beta; + + alpha = p[0]; + beta = p[1]; + + webbur::jacobi_compute_points ( order, alpha, beta, x ); + + return; +} +//****************************************************************************80 + +void jacobi_compute_weights ( int order, double alpha, double beta, + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_COMPUTE_WEIGHTS computes Jacobi quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 14 October 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, double ALPHA, BETA, the exponents of the (1-X) and (1+X) factors. +// +// Output, double W[ORDER], the weights. +// +{ + double *x; + + x = new double[order]; + + webbur::jacobi_compute ( order, alpha, beta, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void jacobi_compute_weights_np ( int order, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_COMPUTE_WEIGHTS_NP computes Jacobi quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameter values. +// P[0] = ALPHA, the exponent of (1-X) +// P[1] = BETA, the exponent of (1+X). +// -1.0 < ALPHA and -1.0 < BETA are required. +// +// Output, double W[ORDER], the weights. +// +{ + double alpha; + double beta; + + alpha = p[0]; + beta = p[1]; + + webbur::jacobi_compute_weights ( order, alpha, beta, w ); + + return; +} +//****************************************************************************80 + +double jacobi_integral ( int expon, double alpha, double beta ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_INTEGRAL integrates a monomial with Jacobi weight. +// +// Discussion: +// +// VALUE = Integral ( -1 <= X <= +1 ) x^EXPON (1-x)^ALPHA (1+x)^BETA dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 08 September 2007 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int EXPON, the exponent. +// +// Input, double ALPHA, the exponent of (1-X) in the weight factor. +// +// Input, double BETA, the exponent of (1+X) in the weight factor. +// +// Output, double JACOBI_INTEGRAL, the value of the integral. +// +{ + double arg1; + double arg2; + double arg3; + double arg4; + double c; + double s; + double value; + double value1; + double value2; + + c = ( double ) ( expon ); + + if ( ( expon % 2 ) == 0 ) + { + s = +1.0; + } + else + { + s = -1.0; + } + + arg1 = - alpha; + arg2 = 1.0 + c; + arg3 = 2.0 + beta + c; + arg4 = - 1.0; + + value1 = webbur::r8_hyper_2f1 ( arg1, arg2, arg3, arg4 ); + + arg1 = - beta; + arg2 = 1.0 + c; + arg3 = 2.0 + alpha + c; + arg4 = - 1.0; + + value2 = webbur::r8_hyper_2f1 ( arg1, arg2, arg3, arg4 ); + + value = webbur::r8_gamma ( 1.0 + c ) * ( + s * webbur::r8_gamma ( 1.0 + beta ) * value1 + / webbur::r8_gamma ( 2.0 + beta + c ) + + webbur::r8_gamma ( 1.0 + alpha ) * value2 + / webbur::r8_gamma ( 2.0 + alpha + c ) ); + + return value; +} +//****************************************************************************80 + +void jacobi_ss_compute ( int order, double alpha, double beta, double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_SS_COMPUTE computes a Jacobi quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) (1-X)^ALPHA * (1+X)^BETA * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// Thanks to Xu Xiang of Fudan University for pointing out that +// an earlier implementation of this routine was incorrect! +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 February 2008 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, double ALPHA, BETA, the exponents of (1-X) and +// (1+X) in the quadrature rule. For simple Legendre quadrature, +// set ALPHA = BETA = 0.0. -1.0 < ALPHA and -1.0 < BETA are required. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double an; + double *b; + double bn; + double *c; + double cc; + double delta; + double dp2; + int i; + double p1; + double prod; + double r1; + double r2; + double r3; + double temp; + double x0; + + if ( order < 1 ) + { + std::cerr << "\n"; + std::cerr << "JACOBI_SS_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of ORDER = " << order << "\n"; + std::exit ( 1 ); + } + + b = new double[order]; + c = new double[order]; +// +// Check ALPHA and BETA. +// + if ( alpha <= -1.0 ) + { + std::cerr << "\n"; + std::cerr << "JACOBI_SS_COMPUTE - Fatal error!\n"; + std::cerr << " -1.0 < ALPHA is required.\n"; + std::exit ( 1 ); + } + + if ( beta <= -1.0 ) + { + std::cerr << "\n"; + std::cerr << "JACOBI_SS_COMPUTE - Fatal error!\n"; + std::cerr << " -1.0 < BETA is required.\n"; + std::exit ( 1 ); + } +// +// Set the recursion coefficients. +// + for ( i = 1; i <= order; i++ ) + { + if ( alpha + beta == 0.0 || beta - alpha == 0.0 ) + { + b[i-1] = 0.0; + } + else + { + b[i-1] = ( alpha + beta ) * ( beta - alpha ) / + ( ( alpha + beta + ( double ) ( 2 * i ) ) + * ( alpha + beta + ( double ) ( 2 * i - 2 ) ) ); + } + + if ( i == 1 ) + { + c[i-1] = 0.0; + } + else + { + c[i-1] = 4.0 * ( double ) ( i - 1 ) + * ( alpha + ( double ) ( i - 1 ) ) + * ( beta + ( double ) ( i - 1 ) ) + * ( alpha + beta + ( double ) ( i - 1 ) ) / + ( ( alpha + beta + ( double ) ( 2 * i - 1 ) ) + * std::pow ( alpha + beta + ( double ) ( 2 * i - 2 ), 2 ) + * ( alpha + beta + ( double ) ( 2 * i - 3 ) ) ); + } + } + + delta = webbur::r8_gamma ( alpha + 1.0 ) + * webbur::r8_gamma ( beta + 1.0 ) + / webbur::r8_gamma ( alpha + beta + 2.0 ); + + prod = 1.0; + for ( i = 2; i <= order; i++ ) + { + prod = prod * c[i-1]; + } + cc = delta * std::pow ( 2.0, alpha + beta + 1.0 ) * prod; + + for ( i = 1; i <= order; i++ ) + { + if ( i == 1 ) + { + an = alpha / ( double ) ( order ); + bn = beta / ( double ) ( order ); + + r1 = ( 1.0 + alpha ) + * ( 2.78 / ( 4.0 + ( double ) ( order * order ) ) + + 0.768 * an / ( double ) ( order ) ); + + r2 = 1.0 + 1.48 * an + 0.96 * bn + + 0.452 * an * an + 0.83 * an * bn; + + x0 = ( r2 - r1 ) / r2; + } + else if ( i == 2 ) + { + r1 = ( 4.1 + alpha ) / + ( ( 1.0 + alpha ) * ( 1.0 + 0.156 * alpha ) ); + + r2 = 1.0 + 0.06 * ( ( double ) ( order ) - 8.0 ) * + ( 1.0 + 0.12 * alpha ) / ( double ) ( order ); + + r3 = 1.0 + 0.012 * beta * + ( 1.0 + 0.25 * r8_abs ( alpha ) ) / ( double ) ( order ); + + x0 = x0 - r1 * r2 * r3 * ( 1.0 - x0 ); + } + else if ( i == 3 ) + { + r1 = ( 1.67 + 0.28 * alpha ) / ( 1.0 + 0.37 * alpha ); + + r2 = 1.0 + 0.22 * ( ( double ) ( order ) - 8.0 ) + / ( double ) ( order ); + + r3 = 1.0 + 8.0 * beta / + ( ( 6.28 + beta ) * ( double ) ( order * order ) ); + + x0 = x0 - r1 * r2 * r3 * ( x[0] - x0 ); + } + else if ( i < order - 1 ) + { + x0 = 3.0 * x[i-2] - 3.0 * x[i-3] + x[i-4]; + } + else if ( i == order - 1 ) + { + r1 = ( 1.0 + 0.235 * beta ) / ( 0.766 + 0.119 * beta ); + + r2 = 1.0 / ( 1.0 + 0.639 + * ( ( double ) ( order ) - 4.0 ) + / ( 1.0 + 0.71 * ( ( double ) ( order ) - 4.0 ) ) ); + + r3 = 1.0 / ( 1.0 + 20.0 * alpha / ( ( 7.5 + alpha ) * + ( double ) ( order * order ) ) ); + + x0 = x0 + r1 * r2 * r3 * ( x0 - x[i-3] ); + } + else if ( i == order ) + { + r1 = ( 1.0 + 0.37 * beta ) / ( 1.67 + 0.28 * beta ); + + r2 = 1.0 / + ( 1.0 + 0.22 * ( ( double ) ( order ) - 8.0 ) + / ( double ) ( order ) ); + + r3 = 1.0 / ( 1.0 + 8.0 * alpha / + ( ( 6.28 + alpha ) * ( double ) ( order * order ) ) ); + + x0 = x0 + r1 * r2 * r3 * ( x0 - x[i-3] ); + } + + webbur::jacobi_ss_root ( &x0, order, alpha, beta, &dp2, &p1, b, c ); + + x[i-1] = x0; + w[i-1] = cc / ( dp2 * p1 ); + } +// +// Reverse the order of the values. +// + for ( i = 1; i <= order/2; i++ ) + { + temp = x[i-1]; + x[i-1] = x[order-i]; + x[order-i] = temp; + } + + for ( i = 1; i <=order/2; i++ ) + { + temp = w[i-1]; + w[i-1] = w[order-i]; + w[order-i] = temp; + } + + delete [] b; + delete [] c; + + return; +} +//****************************************************************************80 + +void jacobi_ss_recur ( double *p2, double *dp2, double *p1, double x, int order, + double alpha, double beta, double b[], double c[] ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_SS_RECUR evaluates a Jacobi polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 February 2008 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Output, double *P2, the value of J(ORDER)(X). +// +// Output, double *DP2, the value of J'(ORDER)(X). +// +// Output, double *P1, the value of J(ORDER-1)(X). +// +// Input, double X, the point at which polynomials are evaluated. +// +// Input, int ORDER, the order of the polynomial. +// +// Input, double ALPHA, BETA, the exponents of (1-X) and +// (1+X) in the quadrature rule. +// +// Input, double B[ORDER], C[ORDER], the recursion coefficients. +// +{ + double dp0; + double dp1; + int i; + double p0; + + *p1 = 1.0; + dp1 = 0.0; + + *p2 = x + ( alpha - beta ) / ( alpha + beta + 2.0 ); + *dp2 = 1.0; + + for ( i = 2; i <= order; i++ ) + { + p0 = *p1; + dp0 = dp1; + + *p1 = *p2; + dp1 = *dp2; + + *p2 = ( x - b[i-1] ) * ( *p1 ) - c[i-1] * p0; + *dp2 = ( x - b[i-1] ) * dp1 + ( *p1 ) - c[i-1] * dp0; + } + return; +} +//****************************************************************************80 + +void jacobi_ss_root ( double *x, int order, double alpha, double beta, + double *dp2, double *p1, double b[], double c[] ) + +//****************************************************************************80 +// +// Purpose: +// +// JACOBI_SS_ROOT improves an approximate root of a Jacobi polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 February 2008 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input/output, double *X, the approximate root, which +// should be improved on output. +// +// Input, int ORDER, the order of the polynomial. +// +// Input, double ALPHA, BETA, the exponents of (1-X) and +// (1+X) in the quadrature rule. +// +// Output, double *DP2, the value of J'(ORDER)(X). +// +// Output, double *P1, the value of J(ORDER-1)(X). +// +// Input, double B[ORDER], C[ORDER], the recursion coefficients. +// +{ + double d; + double eps; + double p2; + int step; + int step_max = 10; + + eps = webbur::r8_epsilon ( ); + + for ( step = 1; step <= step_max; step++ ) + { + webbur::jacobi_ss_recur ( &p2, dp2, p1, *x, order, alpha, beta, b, c ); + + d = p2 / ( *dp2 ); + *x = *x - d; + + if ( webbur::r8_abs ( d ) <= eps * ( webbur::r8_abs ( *x ) + 1.0 ) ) + { + return; + } + } + return; +} +//****************************************************************************80 + +void laguerre_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_COMPUTE: Laguerre quadrature rule by the Elhay-Kautsky method. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky. +// C++ version by John Burkardt. +// +// Reference: +// +// Sylvan Elhay, Jaroslav Kautsky, +// Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of +// Interpolatory Quadrature, +// ACM Transactions on Mathematical Software, +// Volume 13, Number 4, December 1987, pages 399-415. +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double *bj; + int i; + double zemu; +// +// Define the zero-th moment. +// + zemu = 1.0; +// +// Define the Jacobi matrix. +// + bj = new double[n]; + + for ( i = 0; i < n; i++ ) + { + bj[i] = ( double ) ( i + 1 ); + } + + for ( i = 0; i < n; i++ ) + { + x[i] = ( double ) ( 2 * i + 1 ); + } + + w[0] = std::sqrt ( zemu ); + + for ( i = 1; i < n; i++ ) + { + w[i] = 0.0; + } +// +// Diagonalize the Jacobi matrix. +// + webbur::imtqlx ( n, x, bj, w ); + + for ( i = 0; i < n; i++ ) + { + w[i] = w[i] * w[i]; + } + + delete [] bj; + + return; +} +//****************************************************************************80 + +void laguerre_compute_np ( int order, int np, double p[], double x[], + double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_COMPUTE_NP computes a Laguerre quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( 0 <= X < +oo ) exp ( - X ) * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// The integral: +// +// Integral ( A <= X < +oo ) F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * exp ( X(I) ) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + webbur::laguerre_compute ( order, x, w ); + + return; +} +//****************************************************************************80 + +void laguerre_compute_points ( int order, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_COMPUTE_POINTS computes Laguerre quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Output, double X[ORDER], the abscissas. +// +{ + double *w; + + w = new double[order]; + + webbur::laguerre_compute ( order, x, w ); + + delete [] w; + + return; +} +//****************************************************************************80 + +void laguerre_compute_points_np ( int order, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_COMPUTE_POINTS_NP computes Laguerre quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[ORDER], the abscissas. +// +{ + webbur::laguerre_compute_points ( order, x ); + + return; +} +//****************************************************************************80 + +void laguerre_compute_weights ( int order, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_COMPUTE_WEIGHTS computes Laguerre quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Output, double W[ORDER], the weights. +// +{ + double *x; + + x = new double[order]; + + webbur::laguerre_compute ( order, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void laguerre_compute_weights_np ( int order, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_COMPUTE_WEIGHTS_NP computes Laguerre quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int ORDER, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[ORDER], the weights. +// +{ + webbur::laguerre_compute_weights ( order, w ); + + return; +} +//****************************************************************************80 + +double laguerre_integral ( int expon ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_INTEGRAL evaluates a monomial Laguerre integral. +// +// Discussion: +// +// The integral: +// +// integral ( 0 <= x < +oo ) x^n * exp ( -x ) dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int EXPON, the exponent. +// 0 <= EXPON. +// +// Output, double EXACT, the value of the integral. +// +{ + double exact; + + exact = webbur::r8_factorial ( expon ); + + return exact; +} +//****************************************************************************80 + +void laguerre_lookup ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_LOOKUP looks up abscissas and weights for Laguerre quadrature. +// +// Discussion: +// +// The abscissas are the zeroes of the Laguerre polynomial L(N)(X). +// +// The integral: +// +// Integral ( 0 <= X < +oo ) exp ( -X ) * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= N ) W(I) * f ( X(I) ) +// +// The integral: +// +// Integral ( 0 <= X < +oo ) F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= N ) W(I) * exp ( X(I) ) * f ( X(I) ) +// +// Mathematica can numerically estimate the abscissas for the +// n-th order polynomial to p digits of precision by the command: +// +// NSolve [ LaguerreL[n,x] == 0, x, p ] +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 April 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Vladimir Krylov, +// Approximate Calculation of Integrals, +// Dover, 2006, +// ISBN: 0486445798, +// LC: QA311.K713. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Stephen Wolfram, +// The Mathematica Book, +// Fourth Edition, +// Cambridge University Press, 1999, +// ISBN: 0-521-64314-7, +// LC: QA76.95.W65. +// +// Daniel Zwillinger, editor, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, +// CRC Press, 1996, +// ISBN: 0-8493-2479-3. +// +// Parameters: +// +// Input, int N, the order. +// N must be between 1 and 20. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::laguerre_lookup_points ( n, x ); + + webbur::laguerre_lookup_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void laguerre_lookup_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_LOOKUP_POINTS looks up abscissas for Laguerre quadrature. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 April 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Vladimir Krylov, +// Approximate Calculation of Integrals, +// Dover, 2006, +// ISBN: 0486445798, +// LC: QA311.K713. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Stephen Wolfram, +// The Mathematica Book, +// Fourth Edition, +// Cambridge University Press, 1999, +// ISBN: 0-521-64314-7, +// LC: QA76.95.W65. +// +// Daniel Zwillinger, editor, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, +// CRC Press, 1996, +// ISBN: 0-8493-2479-3. +// +// Parameters: +// +// Input, int N, the order. +// N must be between 1 and 20. +// +// Output, double X[N], the abscissas. +// +{ + if ( n == 1 ) + { + x[0] = 1.00000000000000000000000000000E+00; + } + else if ( n == 2 ) + { + x[0] = 0.585786437626904951198311275790E+00; + x[1] = 3.41421356237309504880168872421E+00; + } + else if ( n == 3 ) + { + x[0] = 0.415774556783479083311533873128E+00; + x[1] = 2.29428036027904171982205036136E+00; + x[2] = 6.28994508293747919686641576551E+00; + } + else if ( n == 4 ) + { + x[0] = 0.322547689619392311800361459104E+00; + x[1] = 1.74576110115834657568681671252E+00; + x[2] = 4.53662029692112798327928538496E+00; + x[3] = 9.39507091230113312923353644342E+00; + } + else if ( n == 5 ) + { + x[0] = 0.263560319718140910203061943361E+00; + x[1] = 1.41340305910651679221840798019E+00; + x[2] = 3.59642577104072208122318658878E+00; + x[3] = 7.08581000585883755692212418111E+00; + x[4] = 12.6408008442757826594332193066E+00; + } + else if ( n == 6 ) + { + x[0] = 0.222846604179260689464354826787E+00; + x[1] = 1.18893210167262303074315092194E+00; + x[2] = 2.99273632605931407769132528451E+00; + x[3] = 5.77514356910451050183983036943E+00; + x[4] = 9.83746741838258991771554702994E+00; + x[5] = 15.9828739806017017825457915674E+00; + } + else if ( n == 7 ) + { + x[0] = 0.193043676560362413838247885004E+00; + x[1] = 1.02666489533919195034519944317E+00; + x[2] = 2.56787674495074620690778622666E+00; + x[3] = 4.90035308452648456810171437810E+00; + x[4] = 8.18215344456286079108182755123E+00; + x[5] = 12.7341802917978137580126424582E+00; + x[6] = 19.3957278622625403117125820576E+00; + } + else if ( n == 8 ) + { + x[0] = 0.170279632305100999788861856608E+00; + x[1] = 0.903701776799379912186020223555E+00; + x[2] = 2.25108662986613068930711836697E+00; + x[3] = 4.26670017028765879364942182690E+00; + x[4] = 7.04590540239346569727932548212E+00; + x[5] = 10.7585160101809952240599567880E+00; + x[6] = 15.7406786412780045780287611584E+00; + x[7] = 22.8631317368892641057005342974E+00; + } + else if ( n == 9 ) + { + x[0] = 0.152322227731808247428107073127E+00; + x[1] = 0.807220022742255847741419210952E+00; + x[2] = 2.00513515561934712298303324701E+00; + x[3] = 3.78347397333123299167540609364E+00; + x[4] = 6.20495677787661260697353521006E+00; + x[5] = 9.37298525168757620180971073215E+00; + x[6] = 13.4662369110920935710978818397E+00; + x[7] = 18.8335977889916966141498992996E+00; + x[8] = 26.3740718909273767961410072937E+00; + } + else if ( n == 10 ) + { + x[0] = 0.137793470540492430830772505653E+00; + x[1] = 0.729454549503170498160373121676E+00; + x[2] = 1.80834290174031604823292007575E+00; + x[3] = 3.40143369785489951448253222141E+00; + x[4] = 5.55249614006380363241755848687E+00; + x[5] = 8.33015274676449670023876719727E+00; + x[6] = 11.8437858379000655649185389191E+00; + x[7] = 16.2792578313781020995326539358E+00; + x[8] = 21.9965858119807619512770901956E+00; + x[9] = 29.9206970122738915599087933408E+00; + } + else if ( n == 11 ) + { + x[0] = 0.125796442187967522675794577516E+00; + x[1] = 0.665418255839227841678127839420E+00; + x[2] = 1.64715054587216930958700321365E+00; + x[3] = 3.09113814303525495330195934259E+00; + x[4] = 5.02928440157983321236999508366E+00; + x[5] = 7.50988786380661681941099714450E+00; + x[6] = 10.6059509995469677805559216457E+00; + x[7] = 14.4316137580641855353200450349E+00; + x[8] = 19.1788574032146786478174853989E+00; + x[9] = 25.2177093396775611040909447797E+00; + x[10] = 33.4971928471755372731917259395E+00; + } + else if ( n == 12 ) + { + x[0] = 0.115722117358020675267196428240E+00; + x[1] = 0.611757484515130665391630053042E+00; + x[2] = 1.51261026977641878678173792687E+00; + x[3] = 2.83375133774350722862747177657E+00; + x[4] = 4.59922763941834848460572922485E+00; + x[5] = 6.84452545311517734775433041849E+00; + x[6] = 9.62131684245686704391238234923E+00; + x[7] = 13.0060549933063477203460524294E+00; + x[8] = 17.1168551874622557281840528008E+00; + x[9] = 22.1510903793970056699218950837E+00; + x[10] = 28.4879672509840003125686072325E+00; + x[11] = 37.0991210444669203366389142764E+00; + } + else if ( n == 13 ) + { + x[0] = 0.107142388472252310648493376977E+00; + x[1] = 0.566131899040401853406036347177E+00; + x[2] = 1.39856433645101971792750259921E+00; + x[3] = 2.61659710840641129808364008472E+00; + x[4] = 4.23884592901703327937303389926E+00; + x[5] = 6.29225627114007378039376523025E+00; + x[6] = 8.81500194118697804733348868036E+00; + x[7] = 11.8614035888112425762212021880E+00; + x[8] = 15.5107620377037527818478532958E+00; + x[9] = 19.8846356638802283332036594634E+00; + x[10] = 25.1852638646777580842970297823E+00; + x[11] = 31.8003863019472683713663283526E+00; + x[12] = 40.7230086692655795658979667001E+00; + } + else if ( n == 14 ) + { + x[0] = 0.0997475070325975745736829452514E+00; + x[1] = 0.526857648851902896404583451502E+00; + x[2] = 1.30062912125149648170842022116E+00; + x[3] = 2.43080107873084463616999751038E+00; + x[4] = 3.93210282229321888213134366778E+00; + x[5] = 5.82553621830170841933899983898E+00; + x[6] = 8.14024014156514503005978046052E+00; + x[7] = 10.9164995073660188408130510904E+00; + x[8] = 14.2108050111612886831059780825E+00; + x[9] = 18.1048922202180984125546272083E+00; + x[10] = 22.7233816282696248232280886985E+00; + x[11] = 28.2729817232482056954158923218E+00; + x[12] = 35.1494436605924265828643121364E+00; + x[13] = 44.3660817111174230416312423666E+00; + } + else if ( n == 15 ) + { + x[0] = 0.0933078120172818047629030383672E+00; + x[1] = 0.492691740301883908960101791412E+00; + x[2] = 1.21559541207094946372992716488E+00; + x[3] = 2.26994952620374320247421741375E+00; + x[4] = 3.66762272175143727724905959436E+00; + x[5] = 5.42533662741355316534358132596E+00; + x[6] = 7.56591622661306786049739555812E+00; + x[7] = 10.1202285680191127347927394568E+00; + x[8] = 13.1302824821757235640991204176E+00; + x[9] = 16.6544077083299578225202408430E+00; + x[10] = 20.7764788994487667729157175676E+00; + x[11] = 25.6238942267287801445868285977E+00; + x[12] = 31.4075191697539385152432196202E+00; + x[13] = 38.5306833064860094162515167595E+00; + x[14] = 48.0260855726857943465734308508E+00; + } + else if ( n == 16 ) + { + x[0] = 0.0876494104789278403601980973401E+00; + x[1] = 0.462696328915080831880838260664E+00; + x[2] = 1.14105777483122685687794501811E+00; + x[3] = 2.12928364509838061632615907066E+00; + x[4] = 3.43708663389320664523510701675E+00; + x[5] = 5.07801861454976791292305830814E+00; + x[6] = 7.07033853504823413039598947080E+00; + x[7] = 9.43831433639193878394724672911E+00; + x[8] = 12.2142233688661587369391246088E+00; + x[9] = 15.4415273687816170767647741622E+00; + x[10] = 19.1801568567531348546631409497E+00; + x[11] = 23.5159056939919085318231872752E+00; + x[12] = 28.5787297428821403675206137099E+00; + x[13] = 34.5833987022866258145276871778E+00; + x[14] = 41.9404526476883326354722330252E+00; + x[15] = 51.7011603395433183643426971197E+00; + } + else if ( n == 17 ) + { + x[0] = 0.0826382147089476690543986151980E+00; + x[1] = 0.436150323558710436375959029847E+00; + x[2] = 1.07517657751142857732980316755E+00; + x[3] = 2.00519353164923224070293371933E+00; + x[4] = 3.23425612404744376157380120696E+00; + x[5] = 4.77351351370019726480932076262E+00; + x[6] = 6.63782920536495266541643929703E+00; + x[7] = 8.84668551116980005369470571184E+00; + x[8] = 11.4255293193733525869726151469E+00; + x[9] = 14.4078230374813180021982874959E+00; + x[10] = 17.8382847307011409290658752412E+00; + x[11] = 21.7782682577222653261749080522E+00; + x[12] = 26.3153178112487997766149598369E+00; + x[13] = 31.5817716804567331343908517497E+00; + x[14] = 37.7960938374771007286092846663E+00; + x[15] = 45.3757165339889661829258363215E+00; + x[16] = 55.3897517898396106640900199790E+00; + } + else if ( n == 18 ) + { + x[0] = 0.0781691666697054712986747615334E+00; + x[1] = 0.412490085259129291039101536536E+00; + x[2] = 1.01652017962353968919093686187E+00; + x[3] = 1.89488850996976091426727831954E+00; + x[4] = 3.05435311320265975115241130719E+00; + x[5] = 4.50420553888989282633795571455E+00; + x[6] = 6.25672507394911145274209116326E+00; + x[7] = 8.32782515660563002170470261564E+00; + x[8] = 10.7379900477576093352179033397E+00; + x[9] = 13.5136562075550898190863812108E+00; + x[10] = 16.6893062819301059378183984163E+00; + x[11] = 20.3107676262677428561313764553E+00; + x[12] = 24.4406813592837027656442257980E+00; + x[13] = 29.1682086625796161312980677805E+00; + x[14] = 34.6279270656601721454012429438E+00; + x[15] = 41.0418167728087581392948614284E+00; + x[16] = 48.8339227160865227486586093290E+00; + x[17] = 59.0905464359012507037157810181E+00; + } + else if ( n == 19 ) + { + x[0] = 0.0741587837572050877131369916024E+00; + x[1] = 0.391268613319994607337648350299E+00; + x[2] = 0.963957343997958058624878377130E+00; + x[3] = 1.79617558206832812557725825252E+00; + x[4] = 2.89365138187378399116494713237E+00; + x[5] = 4.26421553962776647436040018167E+00; + x[6] = 5.91814156164404855815360191408E+00; + x[7] = 7.86861891533473373105668358176E+00; + x[8] = 10.1324237168152659251627415800E+00; + x[9] = 12.7308814638423980045092979656E+00; + x[10] = 15.6912783398358885454136069861E+00; + x[11] = 19.0489932098235501532136429732E+00; + x[12] = 22.8508497608294829323930586693E+00; + x[13] = 27.1606693274114488789963947149E+00; + x[14] = 32.0691222518622423224362865906E+00; + x[15] = 37.7129058012196494770647508283E+00; + x[16] = 44.3173627958314961196067736013E+00; + x[17] = 52.3129024574043831658644222420E+00; + x[18] = 62.8024231535003758413504690673E+00; + } + else if ( n == 20 ) + { + x[0] = 0.0705398896919887533666890045842E+00; + x[1] = 0.372126818001611443794241388761E+00; + x[2] = 0.916582102483273564667716277074E+00; + x[3] = 1.70730653102834388068768966741E+00; + x[4] = 2.74919925530943212964503046049E+00; + x[5] = 4.04892531385088692237495336913E+00; + x[6] = 5.61517497086161651410453988565E+00; + x[7] = 7.45901745367106330976886021837E+00; + x[8] = 9.59439286958109677247367273428E+00; + x[9] = 12.0388025469643163096234092989E+00; + x[10] = 14.8142934426307399785126797100E+00; + x[11] = 17.9488955205193760173657909926E+00; + x[12] = 21.4787882402850109757351703696E+00; + x[13] = 25.4517027931869055035186774846E+00; + x[14] = 29.9325546317006120067136561352E+00; + x[15] = 35.0134342404790000062849359067E+00; + x[16] = 40.8330570567285710620295677078E+00; + x[17] = 47.6199940473465021399416271529E+00; + x[18] = 55.8107957500638988907507734445E+00; + x[19] = 66.5244165256157538186403187915E+00; + } + else + { + std::cerr << "\n"; + std::cerr << "LAGUERRE_LOOKUP_POINTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::cerr << " Legal values are 1 through 20.\n"; + std::exit ( 1 ); + } + + return; +} +//****************************************************************************80 + +void laguerre_lookup_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_LOOKUP_WEIGHTS looks up weights for Laguerre quadrature. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 April 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Vladimir Krylov, +// Approximate Calculation of Integrals, +// Dover, 2006, +// ISBN: 0486445798, +// LC: QA311.K713. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Stephen Wolfram, +// The Mathematica Book, +// Fourth Edition, +// Cambridge University Press, 1999, +// ISBN: 0-521-64314-7, +// LC: QA76.95.W65. +// +// Daniel Zwillinger, editor, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, +// CRC Press, 1996, +// ISBN: 0-8493-2479-3. +// +// Parameters: +// +// Input, int N, the order. +// N must be between 1 and 20. +// +// Output, double W[N], the weights. +// +{ + if ( n == 1 ) + { + w[0] = 1.00000000000000000000000000000E+00; + } + else if ( n == 2 ) + { + w[0] = 0.85355339059327376220042218105E+00; + w[1] = 0.146446609406726237799577818948E+00; + } + else if ( n == 3 ) + { + w[0] = 0.71109300992917301544959019114E+00; + w[1] = 0.27851773356924084880144488846E+00; + w[2] = 0.010389256501586135748964920401E+00; + } + else if ( n == 4 ) + { + w[0] = 0.60315410434163360163596602382E+00; + w[1] = 0.35741869243779968664149201746E+00; + w[2] = 0.03888790851500538427243816816E+00; + w[3] = 0.0005392947055613274501037905676E+00; + } + else if ( n == 5 ) + { + w[0] = 0.52175561058280865247586092879E+00; + w[1] = 0.3986668110831759274541333481E+00; + w[2] = 0.0759424496817075953876533114E+00; + w[3] = 0.00361175867992204845446126257E+00; + w[4] = 0.00002336997238577622789114908455E+00; + } + else if ( n == 6 ) + { + w[0] = 0.45896467394996359356828487771E+00; + w[1] = 0.4170008307721209941133775662E+00; + w[2] = 0.1133733820740449757387061851E+00; + w[3] = 0.01039919745314907489891330285E+00; + w[4] = 0.000261017202814932059479242860E+00; + w[5] = 8.98547906429621238825292053E-07; + } + else if ( n == 7 ) + { + w[0] = 0.40931895170127390213043288002E+00; + w[1] = 0.4218312778617197799292810054E+00; + w[2] = 0.1471263486575052783953741846E+00; + w[3] = 0.0206335144687169398657056150E+00; + w[4] = 0.00107401014328074552213195963E+00; + w[5] = 0.0000158654643485642012687326223E+00; + w[6] = 3.17031547899558056227132215E-08; + } + else if ( n == 8 ) + { + w[0] = 0.36918858934163752992058283938E+00; + w[1] = 0.4187867808143429560769785813E+00; + w[2] = 0.175794986637171805699659867E+00; + w[3] = 0.033343492261215651522132535E+00; + w[4] = 0.0027945362352256725249389241E+00; + w[5] = 0.00009076508773358213104238501E+00; + w[6] = 8.4857467162725315448680183E-07; + w[7] = 1.04800117487151038161508854E-09; + } + else if ( n == 9 ) + { + w[0] = 0.336126421797962519673467717606E+00; + w[1] = 0.411213980423984387309146942793E+00; + w[2] = 0.199287525370885580860575607212E+00; + w[3] = 0.0474605627656515992621163600479E+00; + w[4] = 0.00559962661079458317700419900556E+00; + w[5] = 0.000305249767093210566305412824291E+00; + w[6] = 6.59212302607535239225572284875E-06; + w[7] = 4.1107693303495484429024104033E-08; + w[8] = 3.29087403035070757646681380323E-11; + } + else if ( n == 10 ) + { + w[0] = 0.30844111576502014154747083468E+00; + w[1] = 0.4011199291552735515157803099E+00; + w[2] = 0.218068287611809421588648523E+00; + w[3] = 0.062087456098677747392902129E+00; + w[4] = 0.009501516975181100553839072E+00; + w[5] = 0.0007530083885875387754559644E+00; + w[6] = 0.00002825923349599565567422564E+00; + w[7] = 4.249313984962686372586577E-07; + w[8] = 1.839564823979630780921535E-09; + w[9] = 9.911827219609008558377547E-13; + } + else if ( n == 11 ) + { + w[0] = 0.28493321289420060505605102472E+00; + w[1] = 0.3897208895278493779375535080E+00; + w[2] = 0.232781831848991333940223796E+00; + w[3] = 0.076564453546196686400854179E+00; + w[4] = 0.014393282767350695091863919E+00; + w[5] = 0.001518880846484873069847776E+00; + w[6] = 0.0000851312243547192259720424E+00; + w[7] = 2.29240387957450407857683E-06; + w[8] = 2.48635370276779587373391E-08; + w[9] = 7.71262693369132047028153E-11; + w[10] = 2.883775868323623861597778E-14; + } + else if ( n == 12 ) + { + w[0] = 0.26473137105544319034973889206E+00; + w[1] = 0.3777592758731379820244905567E+00; + w[2] = 0.244082011319877564254870818E+00; + w[3] = 0.09044922221168093072750549E+00; + w[4] = 0.02010238115463409652266129E+00; + w[5] = 0.002663973541865315881054158E+00; + w[6] = 0.000203231592662999392121433E+00; + w[7] = 8.3650558568197987453363E-06; + w[8] = 1.66849387654091026116990E-07; + w[9] = 1.34239103051500414552392E-09; + w[10] = 3.06160163503502078142408E-12; + w[11] = 8.148077467426241682473119E-16; + } + else if ( n == 13 ) + { + w[0] = 0.24718870842996262134624918596E+00; + w[1] = 0.3656888229005219453067175309E+00; + w[2] = 0.252562420057658502356824289E+00; + w[3] = 0.10347075802418370511421863E+00; + w[4] = 0.02643275441556161577815877E+00; + w[5] = 0.00422039604025475276555209E+00; + w[6] = 0.000411881770472734774892473E+00; + w[7] = 0.0000235154739815532386882897E+00; + w[8] = 7.3173116202490991040105E-07; + w[9] = 1.10884162570398067979151E-08; + w[10] = 6.7708266922058988406462E-11; + w[11] = 1.15997995990507606094507E-13; + w[12] = 2.245093203892758415991872E-17; + } + else if ( n == 14 ) + { + w[0] = 0.23181557714486497784077486110E+00; + w[1] = 0.3537846915975431518023313013E+00; + w[2] = 0.258734610245428085987320561E+00; + w[3] = 0.11548289355692321008730499E+00; + w[4] = 0.03319209215933736003874996E+00; + w[5] = 0.00619286943700661021678786E+00; + w[6] = 0.00073989037786738594242589E+00; + w[7] = 0.000054907194668416983785733E+00; + w[8] = 2.4095857640853774967578E-06; + w[9] = 5.801543981676495180886E-08; + w[10] = 6.819314692484974119616E-10; + w[11] = 3.2212077518948479398089E-12; + w[12] = 4.2213524405165873515980E-15; + w[13] = 6.05237502228918880839871E-19; + } + else if ( n == 15 ) + { + w[0] = 0.21823488594008688985641323645E+00; + w[1] = 0.3422101779228833296389489568E+00; + w[2] = 0.263027577941680097414812275E+00; + w[3] = 0.12642581810593053584303055E+00; + w[4] = 0.04020686492100091484158548E+00; + w[5] = 0.00856387780361183836391576E+00; + w[6] = 0.00121243614721425207621921E+00; + w[7] = 0.00011167439234425194199258E+00; + w[8] = 6.459926762022900924653E-06; + w[9] = 2.226316907096272630332E-07; + w[10] = 4.227430384979365007351E-09; + w[11] = 3.921897267041089290385E-11; + w[12] = 1.4565152640731264063327E-13; + w[13] = 1.4830270511133013354616E-16; + w[14] = 1.60059490621113323104998E-20; + } + else if ( n == 16 ) + { + w[0] = 0.20615171495780099433427363674E+00; + w[1] = 0.3310578549508841659929830987E+00; + w[2] = 0.265795777644214152599502021E+00; + w[3] = 0.13629693429637753997554751E+00; + w[4] = 0.0473289286941252189780623E+00; + w[5] = 0.0112999000803394532312490E+00; + w[6] = 0.0018490709435263108642918E+00; + w[7] = 0.00020427191530827846012602E+00; + w[8] = 0.00001484458687398129877135E+00; + w[9] = 6.828319330871199564396E-07; + w[10] = 1.881024841079673213882E-08; + w[11] = 2.862350242973881619631E-10; + w[12] = 2.127079033224102967390E-12; + w[13] = 6.297967002517867787174E-15; + w[14] = 5.050473700035512820402E-18; + w[15] = 4.1614623703728551904265E-22; + } + else if ( n == 17 ) + { + w[0] = 0.19533220525177083214592729770E+00; + w[1] = 0.3203753572745402813366256320E+00; + w[2] = 0.267329726357171097238809604E+00; + w[3] = 0.14512985435875862540742645E+00; + w[4] = 0.0544369432453384577793806E+00; + w[5] = 0.0143572977660618672917767E+00; + w[6] = 0.0026628247355727725684324E+00; + w[7] = 0.0003436797271562999206118E+00; + w[8] = 0.00003027551783782870109437E+00; + w[9] = 1.768515053231676895381E-06; + w[10] = 6.57627288681043332199E-08; + w[11] = 1.469730932159546790344E-09; + w[12] = 1.81691036255544979555E-11; + w[13] = 1.095401388928687402976E-13; + w[14] = 2.617373882223370421551E-16; + w[15] = 1.6729356931461546908502E-19; + w[16] = 1.06562631627404278815253E-23; + } + else if ( n == 18 ) + { + w[0] = 0.18558860314691880562333775228E+00; + w[1] = 0.3101817663702252936495975957E+00; + w[2] = 0.267866567148536354820854395E+00; + w[3] = 0.15297974746807490655384308E+00; + w[4] = 0.0614349178609616527076780E+00; + w[5] = 0.0176872130807729312772600E+00; + w[6] = 0.0036601797677599177980266E+00; + w[7] = 0.0005406227870077353231284E+00; + w[8] = 0.0000561696505121423113818E+00; + w[9] = 4.01530788370115755859E-06; + w[10] = 1.91466985667567497969E-07; + w[11] = 5.8360952686315941292E-09; + w[12] = 1.07171126695539012773E-10; + w[13] = 1.08909871388883385562E-12; + w[14] = 5.38666474837830887608E-15; + w[15] = 1.049865978035703408779E-17; + w[16] = 5.405398451631053643566E-21; + w[17] = 2.6916532692010286270838E-25; + } + else if ( n == 19 ) + { + w[0] = 0.17676847491591250225103547981E+00; + w[1] = 0.3004781436072543794821568077E+00; + w[2] = 0.267599547038175030772695441E+00; + w[3] = 0.15991337213558021678551215E+00; + w[4] = 0.0682493799761491134552355E+00; + w[5] = 0.0212393076065443249244062E+00; + w[6] = 0.0048416273511483959672501E+00; + w[7] = 0.0008049127473813667665946E+00; + w[8] = 0.0000965247209315350170843E+00; + w[9] = 8.20730525805103054409E-06; + w[10] = 4.8305667247307725394E-07; + w[11] = 1.90499136112328569994E-08; + w[12] = 4.8166846309280615577E-10; + w[13] = 7.3482588395511443768E-12; + w[14] = 6.2022753875726163989E-14; + w[15] = 2.54143084301542272372E-16; + w[16] = 4.07886129682571235007E-19; + w[17] = 1.707750187593837061004E-22; + w[18] = 6.715064649908189959990E-27; + } + else if ( n == 20 ) + { + w[0] = 0.168746801851113862149223899689E+00; + w[1] = 0.291254362006068281716795323812E+00; + w[2] = 0.266686102867001288549520868998E+00; + w[3] = 0.166002453269506840031469127816E+00; + w[4] = 0.0748260646687923705400624639615E+00; + w[5] = 0.0249644173092832210728227383234E+00; + w[6] = 0.00620255084457223684744754785395E+00; + w[7] = 0.00114496238647690824203955356969E+00; + w[8] = 0.000155741773027811974779809513214E+00; + w[9] = 0.0000154014408652249156893806714048E+00; + w[10] = 1.08648636651798235147970004439E-06; + w[11] = 5.33012090955671475092780244305E-08; + w[12] = 1.7579811790505820035778763784E-09; + w[13] = 3.72550240251232087262924585338E-11; + w[14] = 4.76752925157819052449488071613E-13; + w[15] = 3.37284424336243841236506064991E-15; + w[16] = 1.15501433950039883096396247181E-17; + w[17] = 1.53952214058234355346383319667E-20; + w[18] = 5.28644272556915782880273587683E-24; + w[19] = 1.65645661249902329590781908529E-28; + } + else + { + std::cerr << "\n"; + std::cerr << "LAGUERRE_LOOKUP_WEIGHTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::cerr << " Legal values are 1 through 20.\n"; + std::exit ( 1 ); + } + + return; +} +//****************************************************************************80 + +void laguerre_ss_compute ( int order, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_SS_COMPUTE computes a Laguerre quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( 0 <= X < +oo ) exp ( - X ) * F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * F ( X(I) ) +// +// The integral: +// +// Integral ( A <= X < +oo ) F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= ORDER ) W(I) * exp ( X(I) ) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int ORDER, the order. +// 1 <= ORDER. +// +// Output, double X[ORDER], the abscissas. +// +// Output, double W[ORDER], the weights. +// +{ + double *b; + double *c; + double cc; + double dp2; + int i; + int j; + double p1; + double prod; + double r1; + double x0; + + if ( order < 1 ) + { + std::cerr << "\n"; + std::cerr << "LAGUERRE_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of ORDER = " << order << "\n"; + std::exit ( 1 ); + } + + b = new double[order]; + c = new double[order]; +// +// Set the recursion coefficients. +// + for ( i = 0; i < order; i++ ) + { + b[i] = ( double ) ( 2 * i + 1 ); + } + + for ( i = 0; i < order; i++ ) + { + c[i] = ( double ) ( i * i ); + } + prod = 1.0; + for ( i = 1; i < order; i++ ) + { + prod = prod * c[i]; + } + cc = prod; + + for ( i = 0; i < order; i++ ) + { +// +// Compute an estimate for the root. +// + if ( i == 0 ) + { + x0 = 3.0 / ( 1.0 + 2.4 * ( double ) ( order ) ); + } + else if ( i == 1 ) + { + x0 = x0 + 15.0 / ( 1.0 + 2.5 * ( double ) ( order ) ); + } + else + { + r1 = ( 1.0 + 2.55 * ( double ) ( i - 1 ) ) + / ( 1.9 * ( double ) ( i - 1 ) ); + + x0 = x0 + r1 * ( x0 - x[i-2] ); + } +// +// Use iteration to find the root. +// + webbur::laguerre_ss_root ( &x0, order, &dp2, &p1, b, c ); +// +// Set the abscissa and weight. +// + x[i] = x0; +// +// Because of the huge values involved, this calculation breaks down +// for ORDER = 127. +// +// It was originally w[i] = ( cc / dp2 ) / p1, which breaks down sooner. +// + w[i] = ( 1.0 / dp2 ); + for ( j = 2; j <= order; j++ ) + { + w[i] = w[i] * ( double ) ( j - 1 ); + } + w[i] = w[i] / p1; + for ( j = 2; j <= order; j++ ) + { + w[i] = w[i] * ( double ) ( j - 1 ); + } + +// w[i] = ( cc / dp2 ) / p1; + } + + delete [] b; + delete [] c; + + return; +} +//****************************************************************************80 + +void laguerre_ss_recur ( double *p2, double *dp2, double *p1, double x, + int order, double b[], double c[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_SS_RECUR evaluates a Laguerre polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Output, double *P2, the value of L(ORDER)(X). +// +// Output, double *DP2, the value of L'(ORDER)(X). +// +// Output, double *P1, the value of L(ORDER-1)(X). +// +// Input, double X, the point at which polynomials are evaluated. +// +// Input, int ORDER, the order of the polynomial. +// +// Input, double B[ORDER], C[ORDER], the recursion coefficients. +// +{ + double dp0; + double dp1; + int i; + double p0; + + *p1 = 1.0; + dp1 = 0.0; + + *p2 = x - 1.0; + *dp2 = 1.0; + + for ( i = 1; i < order; i++ ) + { + p0 = *p1; + dp0 = dp1; + + *p1 = *p2; + dp1 = *dp2; + + *p2 = ( x - b[i] ) * ( *p1 ) - c[i] * p0; + *dp2 = ( x - b[i] ) * dp1 + ( *p1 ) - c[i] * dp0; + } + + return; +} +//****************************************************************************80 + +void laguerre_ss_root ( double *x, int order, double *dp2, double *p1, + double b[], double c[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LAGUERRE_SS_ROOT improves a root of a Laguerre polynomial. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Arthur Stroud, Don Secrest. +// C++ version by John Burkardt. +// +// Reference: +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input/output, double *X, the approximate root, which +// should be improved on output. +// +// Input, int ORDER, the order of the polynomial. +// +// Output, double *DP2, the value of L'(ORDER)(X). +// +// Output, double *P1, the value of L(ORDER-1)(X). +// +// Input, double B[ORDER], C[ORDER], the recursion coefficients. +// +{ + double d; + double eps; + double p2; + int step; + int step_max = 10; + + eps = webbur::r8_epsilon ( ); + + for ( step = 1; step <= step_max; step++ ) + { + webbur::laguerre_ss_recur ( &p2, dp2, p1, *x, order, b, c ); + + d = p2 / ( *dp2 ); + *x = *x - d; + + if ( webbur::r8_abs ( d ) <= eps * ( webbur::r8_abs ( *x ) + 1.0 ) ) + { + break; + } + } + + return; +} +//****************************************************************************80 + +void legendre_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_COMPUTE: Legendre quadrature rule by the Elhay-Kautsky method. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 April 2011 +// +// Author: +// +// Original FORTRAN77 version by Sylvan Elhay, Jaroslav Kautsky. +// C++ version by John Burkardt. +// +// Reference: +// +// Sylvan Elhay, Jaroslav Kautsky, +// Algorithm 655: IQPACK, FORTRAN Subroutines for the Weights of +// Interpolatory Quadrature, +// ACM Transactions on Mathematical Software, +// Volume 13, Number 4, December 1987, pages 399-415. +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double *bj; + int i; + double zemu; +// +// Define the zero-th moment. +// + zemu = 2.0; +// +// Define the Jacobi matrix. +// + bj = new double[n]; + + for ( i = 0; i < n; i++ ) + { + bj[i] = ( double ) ( ( i + 1 ) * ( i + 1 ) ) + / ( double ) ( 4 * ( i + 1 ) * ( i + 1 ) - 1 ); + bj[i] = std::sqrt ( bj[i] ); + } + + for ( i = 0; i < n; i++ ) + { + x[i] = 0.0; + } + + w[0] = std::sqrt ( zemu ); + + for ( i = 1; i < n; i++ ) + { + w[i] = 0.0; + } +// +// Diagonalize the Jacobi matrix. +// + webbur::imtqlx ( n, x, bj, w ); + + for ( i = 0; i < n; i++ ) + { + w[i] = w[i] * w[i]; + } + + delete [] bj; + + return; +} +//****************************************************************************80 + +void legendre_compute_np ( int n, int np, double p[], double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_COMPUTE_NP computes a Legendre quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= N ) W(I) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// Original FORTRAN77 version by Philip Davis, Philip Rabinowitz. +// C++ version by John Burkardt. +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + webbur::legendre_compute ( n, x, w ); + + return; +} +//****************************************************************************80 + +void legendre_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_COMPUTE_POINTS computes Legendre quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double X[N], the abscissas. +// +{ + double *w; + + w= new double[n]; + + webbur::legendre_compute ( n, x, w ); + + delete [] w; + + return; +} +//****************************************************************************80 + +void legendre_compute_points_np ( int n, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_COMPUTE_POINTS_NP computes Legendre quadrature points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + webbur::legendre_compute_points ( n, x ); + + return; +} +//****************************************************************************80 + +void legendre_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_COMPUTE_WEIGHTS computes Legendre quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double W[N], the weights. +// +{ + double *x; + + x = new double[n]; + + webbur::legendre_compute ( n, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void legendre_compute_weights_np ( int n, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_COMPUTE_WEIGHTS_NP computes Legendre quadrature weights. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + webbur::legendre_compute_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void legendre_dr_compute ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_DR_COMPUTE computes a Legendre quadrature rule. +// +// Discussion: +// +// The integral: +// +// Integral ( -1 <= X <= 1 ) F(X) dX +// +// The quadrature rule: +// +// Sum ( 1 <= I <= N ) W(I) * F ( X(I) ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 June 2009 +// +// Author: +// +// Original FORTRAN77 version by Philip Davis, Philip Rabinowitz. +// C++ version by John Burkardt. +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int N, the order. +// 1 <= N. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double d1; + double d2pn; + double d3pn; + double d4pn; + double dp; + double dpn; + double e1; + double fx; + double h; + int i; + int iback; + int k; + int m; + int mp1mi; + int ncopy; + int nmove; + double p; + double pi = 3.141592653589793; + double pk; + double pkm1; + double pkp1; + double t; + double u; + double v; + double x0; + double xtemp; + + if ( n < 1 ) + { + std::cerr << "\n"; + std::cerr << "LEGENDRE_DR_COMPUTE - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::exit ( 1 ); + } + + e1 = ( double ) ( n * ( n + 1 ) ); + + m = ( n + 1 ) / 2; + + for ( i = 1; i <= m; i++ ) + { + mp1mi = m + 1 - i; + + t = ( double ) ( 4 * i - 1 ) * pi / ( double ) ( 4 * n + 2 ); + + x0 = std::cos ( t ) * ( 1.0 - ( 1.0 - 1.0 / ( double ) ( n ) ) + / ( double ) ( 8 * n * n ) ); + + pkm1 = 1.0; + pk = x0; + + for ( k = 2; k <= n; k++ ) + { + pkp1 = 2.0 * x0 * pk - pkm1 - ( x0 * pk - pkm1 ) / ( double ) ( k ); + pkm1 = pk; + pk = pkp1; + } + + d1 = ( double ) ( n ) * ( pkm1 - x0 * pk ); + + dpn = d1 / ( 1.0 - x0 * x0 ); + + d2pn = ( 2.0 * x0 * dpn - e1 * pk ) / ( 1.0 - x0 * x0 ); + + d3pn = ( 4.0 * x0 * d2pn + ( 2.0 - e1 ) * dpn ) / ( 1.0 - x0 * x0 ); + + d4pn = ( 6.0 * x0 * d3pn + ( 6.0 - e1 ) * d2pn ) / ( 1.0 - x0 * x0 ); + + u = pk / dpn; + v = d2pn / dpn; +// +// Initial approximation H: +// + h = -u * ( 1.0 + 0.5 * u * ( v + u * ( v * v - d3pn / ( 3.0 * dpn ) ) ) ); +// +// Refine H using one step of Newton's method: +// + p = pk + h * ( dpn + 0.5 * h * ( d2pn + h / 3.0 + * ( d3pn + 0.25 * h * d4pn ) ) ); + + dp = dpn + h * ( d2pn + 0.5 * h * ( d3pn + h * d4pn / 3.0 ) ); + + h = h - p / dp; + + xtemp = x0 + h; + + x[mp1mi-1] = xtemp; + + fx = d1 - h * e1 * ( pk + 0.5 * h * ( dpn + h / 3.0 + * ( d2pn + 0.25 * h * ( d3pn + 0.2 * h * d4pn ) ) ) ); + + w[mp1mi-1] = 2.0 * ( 1.0 - xtemp * xtemp ) / ( fx * fx ); + } + + if ( ( n % 2 ) == 1 ) + { + x[0] = 0.0; + } +// +// Shift the data up. +// + nmove = ( n + 1 ) / 2; + ncopy = n - nmove; + + for ( i = 1; i <= nmove; i++ ) + { + iback = n + 1 - i; + x[iback-1] = x[iback-ncopy-1]; + w[iback-1] = w[iback-ncopy-1]; + } +// +// Reflect values for the negative abscissas. +// + for ( i = 1; i <= n - nmove; i++ ) + { + x[i-1] = - x[n-i]; + w[i-1] = w[n-i]; + } + + return; +} +//****************************************************************************80 + +double legendre_integral ( int expon ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_INTEGRAL evaluates a monomial Legendre integral. +// +// Discussion: +// +// The integral: +// +// integral ( -1 <= x <= +1 ) x^n dx +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int EXPON, the exponent. +// +// Output, double LEGENDRE_INTEGRAL, the value of the exact integral. +// +{ + double exact; +// +// Get the exact value of the integral. +// + if ( ( expon % 2 ) == 0 ) + { + exact = 2.0 / ( double ) ( expon + 1 ); + } + else + { + exact = 0.0; + } + + return exact; +} +//****************************************************************************80 + +void legendre_lookup ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_LOOKUP looks up abscissas and weights for Gauss-Legendre quadrature. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 April 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Vladimir Krylov, +// Approximate Calculation of Integrals, +// Dover, 2006, +// ISBN: 0486445798. +// LC: QA311.K713. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Stephen Wolfram, +// The Mathematica Book, +// Fourth Edition, +// Cambridge University Press, 1999, +// ISBN: 0-521-64314-7, +// LC: QA76.95.W65. +// +// Daniel Zwillinger, editor, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, +// CRC Press, 1996, +// ISBN: 0-8493-2479-3, +// LC: QA47.M315. +// +// Parameters: +// +// Input, int N, the order. +// N must be between 1 and 33. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the abscissas. +// +{ + webbur::legendre_lookup_points ( n, x ); + + webbur::legendre_lookup_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void legendre_lookup_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_LOOKUP_POINTS looks up abscissas for Gauss-Legendre quadrature. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 April 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Vladimir Krylov, +// Approximate Calculation of Integrals, +// Dover, 2006, +// ISBN: 0486445798. +// LC: QA311.K713. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Stephen Wolfram, +// The Mathematica Book, +// Fourth Edition, +// Cambridge University Press, 1999, +// ISBN: 0-521-64314-7, +// LC: QA76.95.W65. +// +// Daniel Zwillinger, editor, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, +// CRC Press, 1996, +// ISBN: 0-8493-2479-3, +// LC: QA47.M315. +// +// Parameters: +// +// Input, int N, the order. +// N must be between 1 and 33. +// +// Output, double X[N], the abscissas. +// +{ + if ( n == 1 ) + { + x[0] = 0.000000000000000000000000000000; + } + else if ( n == 2 ) + { + x[0] = -0.577350269189625764509148780502; + x[1] = 0.577350269189625764509148780502; + } + else if ( n == 3 ) + { + x[0] = -0.774596669241483377035853079956; + x[1] = 0.000000000000000000000000000000; + x[2] = 0.774596669241483377035853079956; + } + else if ( n == 4 ) + { + x[0] = -0.861136311594052575223946488893; + x[1] = -0.339981043584856264802665759103; + x[2] = 0.339981043584856264802665759103; + x[3] = 0.861136311594052575223946488893; + } + else if ( n == 5 ) + { + x[0] = -0.906179845938663992797626878299; + x[1] = -0.538469310105683091036314420700; + x[2] = 0.000000000000000000000000000000; + x[3] = 0.538469310105683091036314420700; + x[4] = 0.906179845938663992797626878299; + } + else if ( n == 6 ) + { + x[0] = -0.932469514203152027812301554494; + x[1] = -0.661209386466264513661399595020; + x[2] = -0.238619186083196908630501721681; + x[3] = 0.238619186083196908630501721681; + x[4] = 0.661209386466264513661399595020; + x[5] = 0.932469514203152027812301554494; + } + else if ( n == 7 ) + { + x[0] = -0.949107912342758524526189684048; + x[1] = -0.741531185599394439863864773281; + x[2] = -0.405845151377397166906606412077; + x[3] = 0.000000000000000000000000000000; + x[4] = 0.405845151377397166906606412077; + x[5] = 0.741531185599394439863864773281; + x[6] = 0.949107912342758524526189684048; + } + else if ( n == 8 ) + { + x[0] = -0.960289856497536231683560868569; + x[1] = -0.796666477413626739591553936476; + x[2] = -0.525532409916328985817739049189; + x[3] = -0.183434642495649804939476142360; + x[4] = 0.183434642495649804939476142360; + x[5] = 0.525532409916328985817739049189; + x[6] = 0.796666477413626739591553936476; + x[7] = 0.960289856497536231683560868569; + } + else if ( n == 9 ) + { + x[0] = -0.968160239507626089835576203; + x[1] = -0.836031107326635794299429788; + x[2] = -0.613371432700590397308702039; + x[3] = -0.324253423403808929038538015; + x[4] = 0.000000000000000000000000000; + x[5] = 0.324253423403808929038538015; + x[6] = 0.613371432700590397308702039; + x[7] = 0.836031107326635794299429788; + x[8] = 0.968160239507626089835576203; + } + else if ( n == 10 ) + { + x[0] = -0.973906528517171720077964012; + x[1] = -0.865063366688984510732096688; + x[2] = -0.679409568299024406234327365; + x[3] = -0.433395394129247190799265943; + x[4] = -0.148874338981631210884826001; + x[5] = 0.148874338981631210884826001; + x[6] = 0.433395394129247190799265943; + x[7] = 0.679409568299024406234327365; + x[8] = 0.865063366688984510732096688; + x[9] = 0.973906528517171720077964012; + } + else if ( n == 11 ) + { + x[0] = -0.978228658146056992803938001; + x[1] = -0.887062599768095299075157769; + x[2] = -0.730152005574049324093416252; + x[3] = -0.519096129206811815925725669; + x[4] = -0.269543155952344972331531985; + x[5] = 0.000000000000000000000000000; + x[6] = 0.269543155952344972331531985; + x[7] = 0.519096129206811815925725669; + x[8] = 0.730152005574049324093416252; + x[9] = 0.887062599768095299075157769; + x[10] = 0.978228658146056992803938001; + } + else if ( n == 12 ) + { + x[0] = -0.981560634246719250690549090; + x[1] = -0.904117256370474856678465866; + x[2] = -0.769902674194304687036893833; + x[3] = -0.587317954286617447296702419; + x[4] = -0.367831498998180193752691537; + x[5] = -0.125233408511468915472441369; + x[6] = 0.125233408511468915472441369; + x[7] = 0.367831498998180193752691537; + x[8] = 0.587317954286617447296702419; + x[9] = 0.769902674194304687036893833; + x[10] = 0.904117256370474856678465866; + x[11] = 0.981560634246719250690549090; + } + else if ( n == 13 ) + { + x[0] = -0.984183054718588149472829449; + x[1] = -0.917598399222977965206547837; + x[2] = -0.801578090733309912794206490; + x[3] = -0.642349339440340220643984607; + x[4] = -0.448492751036446852877912852; + x[5] = -0.230458315955134794065528121; + x[6] = 0.000000000000000000000000000; + x[7] = 0.230458315955134794065528121; + x[8] = 0.448492751036446852877912852; + x[9] = 0.642349339440340220643984607; + x[10] = 0.80157809073330991279420649; + x[11] = 0.91759839922297796520654784; + x[12] = 0.98418305471858814947282945; + } + else if ( n == 14 ) + { + x[0] = -0.986283808696812338841597267; + x[1] = -0.928434883663573517336391139; + x[2] = -0.827201315069764993189794743; + x[3] = -0.687292904811685470148019803; + x[4] = -0.515248636358154091965290719; + x[5] = -0.319112368927889760435671824; + x[6] = -0.108054948707343662066244650; + x[7] = 0.108054948707343662066244650; + x[8] = 0.31911236892788976043567182; + x[9] = 0.51524863635815409196529072; + x[10] = 0.68729290481168547014801980; + x[11] = 0.82720131506976499318979474; + x[12] = 0.92843488366357351733639114; + x[13] = 0.98628380869681233884159727; + } + else if ( n == 15 ) + { + x[0] = -0.987992518020485428489565719; + x[1] = -0.937273392400705904307758948; + x[2] = -0.848206583410427216200648321; + x[3] = -0.724417731360170047416186055; + x[4] = -0.570972172608538847537226737; + x[5] = -0.394151347077563369897207371; + x[6] = -0.201194093997434522300628303; + x[7] = 0.00000000000000000000000000; + x[8] = 0.20119409399743452230062830; + x[9] = 0.39415134707756336989720737; + x[10] = 0.57097217260853884753722674; + x[11] = 0.72441773136017004741618605; + x[12] = 0.84820658341042721620064832; + x[13] = 0.93727339240070590430775895; + x[14] = 0.98799251802048542848956572; + } + else if ( n == 16 ) + { + x[0] = -0.989400934991649932596154173; + x[1] = -0.944575023073232576077988416; + x[2] = -0.865631202387831743880467898; + x[3] = -0.755404408355003033895101195; + x[4] = -0.617876244402643748446671764; + x[5] = -0.458016777657227386342419443; + x[6] = -0.281603550779258913230460501; + x[7] = -0.09501250983763744018531934; + x[8] = 0.09501250983763744018531934; + x[9] = 0.28160355077925891323046050; + x[10] = 0.45801677765722738634241944; + x[11] = 0.61787624440264374844667176; + x[12] = 0.75540440835500303389510119; + x[13] = 0.86563120238783174388046790; + x[14] = 0.94457502307323257607798842; + x[15] = 0.98940093499164993259615417; + } + else if ( n == 17 ) + { + x[0] = -0.990575475314417335675434020; + x[1] = -0.950675521768767761222716958; + x[2] = -0.880239153726985902122955694; + x[3] = -0.781514003896801406925230056; + x[4] = -0.657671159216690765850302217; + x[5] = -0.512690537086476967886246569; + x[6] = -0.35123176345387631529718552; + x[7] = -0.17848418149584785585067749; + x[8] = 0.00000000000000000000000000; + x[9] = 0.17848418149584785585067749; + x[10] = 0.35123176345387631529718552; + x[11] = 0.51269053708647696788624657; + x[12] = 0.65767115921669076585030222; + x[13] = 0.78151400389680140692523006; + x[14] = 0.88023915372698590212295569; + x[15] = 0.95067552176876776122271696; + x[16] = 0.99057547531441733567543402; + } + else if ( n == 18 ) + { + x[0] = -0.991565168420930946730016005; + x[1] = -0.955823949571397755181195893; + x[2] = -0.892602466497555739206060591; + x[3] = -0.803704958972523115682417455; + x[4] = -0.691687043060353207874891081; + x[5] = -0.55977083107394753460787155; + x[6] = -0.41175116146284264603593179; + x[7] = -0.25188622569150550958897285; + x[8] = -0.08477501304173530124226185; + x[9] = 0.08477501304173530124226185; + x[10] = 0.25188622569150550958897285; + x[11] = 0.41175116146284264603593179; + x[12] = 0.55977083107394753460787155; + x[13] = 0.69168704306035320787489108; + x[14] = 0.80370495897252311568241746; + x[15] = 0.89260246649755573920606059; + x[16] = 0.95582394957139775518119589; + x[17] = 0.99156516842093094673001600; + } + else if ( n == 19 ) + { + x[0] = -0.992406843843584403189017670; + x[1] = -0.960208152134830030852778841; + x[2] = -0.903155903614817901642660929; + x[3] = -0.822714656537142824978922487; + x[4] = -0.72096617733522937861709586; + x[5] = -0.60054530466168102346963816; + x[6] = -0.46457074137596094571726715; + x[7] = -0.31656409996362983199011733; + x[8] = -0.16035864564022537586809612; + x[9] = 0.00000000000000000000000000; + x[10] = 0.16035864564022537586809612; + x[11] = 0.31656409996362983199011733; + x[12] = 0.46457074137596094571726715; + x[13] = 0.60054530466168102346963816; + x[14] = 0.72096617733522937861709586; + x[15] = 0.82271465653714282497892249; + x[16] = 0.90315590361481790164266093; + x[17] = 0.96020815213483003085277884; + x[18] = 0.99240684384358440318901767; + } + else if ( n == 20 ) + { + x[0] = -0.993128599185094924786122388; + x[1] = -0.963971927277913791267666131; + x[2] = -0.912234428251325905867752441; + x[3] = -0.83911697182221882339452906; + x[4] = -0.74633190646015079261430507; + x[5] = -0.63605368072651502545283670; + x[6] = -0.51086700195082709800436405; + x[7] = -0.37370608871541956067254818; + x[8] = -0.22778585114164507808049620; + x[9] = -0.07652652113349733375464041; + x[10] = 0.07652652113349733375464041; + x[11] = 0.22778585114164507808049620; + x[12] = 0.37370608871541956067254818; + x[13] = 0.51086700195082709800436405; + x[14] = 0.63605368072651502545283670; + x[15] = 0.74633190646015079261430507; + x[16] = 0.83911697182221882339452906; + x[17] = 0.91223442825132590586775244; + x[18] = 0.96397192727791379126766613; + x[19] = 0.99312859918509492478612239; + } + else if ( n == 21 ) + { + x[ 0] = -0.99375217062038950026024204; + x[ 1] = -0.96722683856630629431662221; + x[ 2] = -0.92009933415040082879018713; + x[ 3] = -0.85336336458331728364725064; + x[ 4] = -0.76843996347567790861587785; + x[ 5] = -0.66713880419741231930596667; + x[ 6] = -0.55161883588721980705901880; + x[ 7] = -0.42434212020743878357366889; + x[ 8] = -0.28802131680240109660079252; + x[9] = -0.14556185416089509093703098; + x[10] = 0.00000000000000000000000000; + x[11] = +0.14556185416089509093703098; + x[12] = +0.28802131680240109660079252; + x[13] = +0.42434212020743878357366889; + x[14] = +0.55161883588721980705901880; + x[15] = +0.66713880419741231930596667; + x[16] = +0.76843996347567790861587785; + x[17] = +0.85336336458331728364725064; + x[18] = +0.92009933415040082879018713; + x[19] = +0.96722683856630629431662221; + x[20] = +0.99375217062038950026024204; + } + else if ( n == 22 ) + { + x[0] = -0.99429458548239929207303142; + x[1] = -0.97006049783542872712395099; + x[2] = -0.92695677218717400052069294; + x[3] = -0.86581257772030013653642564; + x[4] = -0.78781680597920816200427796; + x[5] = -0.69448726318668278005068984; + x[6] = -0.58764040350691159295887693; + x[7] = -0.46935583798675702640633071; + x[8] = -0.34193582089208422515814742; + x[9] = -0.20786042668822128547884653; + x[10] = -0.06973927331972222121384180; + x[11] = 0.06973927331972222121384180; + x[12] = 0.20786042668822128547884653; + x[13] = 0.34193582089208422515814742; + x[14] = 0.46935583798675702640633071; + x[15] = 0.58764040350691159295887693; + x[16] = 0.69448726318668278005068984; + x[17] = 0.78781680597920816200427796; + x[18] = 0.86581257772030013653642564; + x[19] = 0.92695677218717400052069294; + x[20] = 0.97006049783542872712395099; + x[21] = 0.99429458548239929207303142; + } + else if ( n == 23 ) + { + x[0] = -0.99476933499755212352392572; + x[1] = -0.97254247121811523195602408; + x[2] = -0.93297108682601610234919699; + x[3] = -0.87675235827044166737815689; + x[4] = -0.80488840161883989215111841; + x[5] = -0.71866136313195019446162448; + x[6] = -0.61960987576364615638509731; + x[7] = -0.50950147784600754968979305; + x[8] = -0.39030103803029083142148887; + x[9] = -0.26413568097034493053386954; + x[10] = -0.13325682429846611093174268; + x[11] = 0.00000000000000000000000000; + x[12] = 0.13325682429846611093174268; + x[13] = 0.26413568097034493053386954; + x[14] = 0.39030103803029083142148887; + x[15] = 0.50950147784600754968979305; + x[16] = 0.61960987576364615638509731; + x[17] = 0.71866136313195019446162448; + x[18] = 0.80488840161883989215111841; + x[19] = 0.87675235827044166737815689; + x[20] = 0.93297108682601610234919699; + x[21] = 0.97254247121811523195602408; + x[22] = 0.99476933499755212352392572; + } + else if ( n == 24 ) + { + x[0] = -0.99518721999702136017999741; + x[1] = -0.97472855597130949819839199; + x[2] = -0.93827455200273275852364900; + x[3] = -0.88641552700440103421315434; + x[4] = -0.82000198597390292195394987; + x[5] = -0.74012419157855436424382810; + x[6] = -0.64809365193697556925249579; + x[7] = -0.54542147138883953565837562; + x[8] = -0.43379350762604513848708423; + x[9] = -0.31504267969616337438679329; + x[10] = -0.19111886747361630915863982; + x[11] = -0.06405689286260562608504308; + x[12] = 0.06405689286260562608504308; + x[13] = 0.19111886747361630915863982; + x[14] = 0.31504267969616337438679329; + x[15] = 0.43379350762604513848708423; + x[16] = 0.54542147138883953565837562; + x[17] = 0.64809365193697556925249579; + x[18] = 0.74012419157855436424382810; + x[19] = 0.82000198597390292195394987; + x[20] = 0.88641552700440103421315434; + x[21] = 0.93827455200273275852364900; + x[22] = 0.97472855597130949819839199; + x[23] = 0.99518721999702136017999741; + } + else if ( n == 25 ) + { + x[0] = -0.99555696979049809790878495; + x[1] = -0.97666392145951751149831539; + x[2] = -0.94297457122897433941401117; + x[3] = -0.89499199787827536885104201; + x[4] = -0.83344262876083400142102111; + x[5] = -0.75925926303735763057728287; + x[6] = -0.67356636847346836448512063; + x[7] = -0.57766293024122296772368984; + x[8] = -0.47300273144571496052218212; + x[9] = -0.36117230580938783773582173; + x[10] = -0.24386688372098843204519036; + x[11] = -0.12286469261071039638735982; + x[12] = 0.00000000000000000000000000; + x[13] = 0.12286469261071039638735982; + x[14] = 0.24386688372098843204519036; + x[15] = 0.36117230580938783773582173; + x[16] = 0.47300273144571496052218212; + x[17] = 0.57766293024122296772368984; + x[18] = 0.67356636847346836448512063; + x[19] = 0.75925926303735763057728287; + x[20] = 0.83344262876083400142102111; + x[21] = 0.89499199787827536885104201; + x[22] = 0.94297457122897433941401117; + x[23] = 0.97666392145951751149831539; + x[24] = 0.99555696979049809790878495; + } + else if ( n == 26 ) + { + x[0] = -0.99588570114561692900321696; + x[1] = -0.97838544595647099110058035; + x[2] = -0.94715906666171425013591528; + x[3] = -0.90263786198430707421766560; + x[4] = -0.84544594278849801879750706; + x[5] = -0.77638594882067885619296725; + x[6] = -0.69642726041995726486381391; + x[7] = -0.60669229301761806323197875; + x[8] = -0.50844071482450571769570306; + x[9] = -0.40305175512348630648107738; + x[10] = -0.29200483948595689514283538; + x[11] = -0.17685882035689018396905775; + x[12] = -0.05923009342931320709371858; + x[13] = 0.05923009342931320709371858; + x[14] = 0.17685882035689018396905775; + x[15] = 0.29200483948595689514283538; + x[16] = 0.40305175512348630648107738; + x[17] = 0.50844071482450571769570306; + x[18] = 0.60669229301761806323197875; + x[19] = 0.69642726041995726486381391; + x[20] = 0.77638594882067885619296725; + x[21] = 0.84544594278849801879750706; + x[22] = 0.90263786198430707421766560; + x[23] = 0.94715906666171425013591528; + x[24] = 0.97838544595647099110058035; + x[25] = 0.99588570114561692900321696; + } + else if ( n == 27 ) + { + x[0] = -0.99617926288898856693888721; + x[1] = -0.97992347596150122285587336; + x[2] = -0.95090055781470500685190803; + x[3] = -0.90948232067749110430064502; + x[4] = -0.85620790801829449030273722; + x[5] = -0.79177163907050822714439734; + x[6] = -0.71701347373942369929481621; + x[7] = -0.63290797194649514092773464; + x[8] = -0.54055156457945689490030094; + x[9] = -0.44114825175002688058597416; + x[10] = -0.33599390363850889973031903; + x[11] = -0.22645936543953685885723911; + x[12] = -0.11397258560952996693289498; + x[13] = 0.00000000000000000000000000; + x[14] = 0.11397258560952996693289498; + x[15] = 0.22645936543953685885723911; + x[16] = 0.33599390363850889973031903; + x[17] = 0.44114825175002688058597416; + x[18] = 0.54055156457945689490030094; + x[19] = 0.63290797194649514092773464; + x[20] = 0.71701347373942369929481621; + x[21] = 0.79177163907050822714439734; + x[22] = 0.85620790801829449030273722; + x[23] = 0.90948232067749110430064502; + x[24] = 0.95090055781470500685190803; + x[25] = 0.97992347596150122285587336; + x[26] = 0.99617926288898856693888721; + } + else if ( n == 28 ) + { + x[0] = -0.99644249757395444995043639; + x[1] = -0.98130316537087275369455995; + x[2] = -0.95425928062893819725410184; + x[3] = -0.91563302639213207386968942; + x[4] = -0.86589252257439504894225457; + x[5] = -0.80564137091717917144788596; + x[6] = -0.73561087801363177202814451; + x[7] = -0.65665109403886496121989818; + x[8] = -0.56972047181140171930800328; + x[9] = -0.47587422495511826103441185; + x[10] = -0.37625151608907871022135721; + x[11] = -0.27206162763517807767682636; + x[12] = -0.16456928213338077128147178; + x[13] = -0.05507928988403427042651653; + x[14] = 0.05507928988403427042651653; + x[15] = 0.16456928213338077128147178; + x[16] = 0.27206162763517807767682636; + x[17] = 0.37625151608907871022135721; + x[18] = 0.47587422495511826103441185; + x[19] = 0.56972047181140171930800328; + x[20] = 0.65665109403886496121989818; + x[21] = 0.73561087801363177202814451; + x[22] = 0.80564137091717917144788596; + x[23] = 0.86589252257439504894225457; + x[24] = 0.91563302639213207386968942; + x[25] = 0.95425928062893819725410184; + x[26] = 0.98130316537087275369455995; + x[27] = 0.99644249757395444995043639; + } + else if ( n == 29 ) + { + x[0] = -0.99667944226059658616319153; + x[1] = -0.98254550526141317487092602; + x[2] = -0.95728559577808772579820804; + x[3] = -0.92118023295305878509375344; + x[4] = -0.87463780492010279041779342; + x[5] = -0.81818548761525244498957221; + x[6] = -0.75246285173447713391261008; + x[7] = -0.67821453760268651515618501; + x[8] = -0.59628179713822782037958621; + x[9] = -0.50759295512422764210262792; + x[10] = -0.41315288817400866389070659; + x[11] = -0.31403163786763993494819592; + x[12] = -0.21135228616600107450637573; + x[13] = -0.10627823013267923017098239; + x[14] = 0.00000000000000000000000000; + x[15] = 0.10627823013267923017098239; + x[16] = 0.21135228616600107450637573; + x[17] = 0.31403163786763993494819592; + x[18] = 0.41315288817400866389070659; + x[19] = 0.50759295512422764210262792; + x[20] = 0.59628179713822782037958621; + x[21] = 0.67821453760268651515618501; + x[22] = 0.75246285173447713391261008; + x[23] = 0.81818548761525244498957221; + x[24] = 0.87463780492010279041779342; + x[25] = 0.92118023295305878509375344; + x[26] = 0.95728559577808772579820804; + x[27] = 0.98254550526141317487092602; + x[28] = 0.99667944226059658616319153; + } + else if ( n == 30 ) + { + x[0] = -0.99689348407464954027163005; + x[1] = -0.98366812327974720997003258; + x[2] = -0.96002186496830751221687103; + x[3] = -0.92620004742927432587932428; + x[4] = -0.88256053579205268154311646; + x[5] = -0.82956576238276839744289812; + x[6] = -0.76777743210482619491797734; + x[7] = -0.69785049479331579693229239; + x[8] = -0.62052618298924286114047756; + x[9] = -0.53662414814201989926416979; + x[10] = -0.44703376953808917678060990; + x[11] = -0.35270472553087811347103721; + x[12] = -0.25463692616788984643980513; + x[13] = -0.15386991360858354696379467; + x[14] = -0.05147184255531769583302521; + x[15] = 0.05147184255531769583302521; + x[16] = 0.15386991360858354696379467; + x[17] = 0.25463692616788984643980513; + x[18] = 0.35270472553087811347103721; + x[19] = 0.44703376953808917678060990; + x[20] = 0.53662414814201989926416979; + x[21] = 0.62052618298924286114047756; + x[22] = 0.69785049479331579693229239; + x[23] = 0.76777743210482619491797734; + x[24] = 0.82956576238276839744289812; + x[25] = 0.88256053579205268154311646; + x[26] = 0.92620004742927432587932428; + x[27] = 0.96002186496830751221687103; + x[28] = 0.98366812327974720997003258; + x[29] = 0.99689348407464954027163005; + } + else if ( n == 31 ) + { + x[0] = -0.99708748181947707405562655; + x[1] = -0.98468590966515248400246517; + x[2] = -0.96250392509294966178905240; + x[3] = -0.93075699789664816495694576; + x[4] = -0.88976002994827104337419201; + x[5] = -0.83992032014626734008690454; + x[6] = -0.78173314841662494040636002; + x[7] = -0.71577678458685328390597087; + x[8] = -0.64270672292426034618441820; + x[9] = -0.56324916140714926272094492; + x[10] = -0.47819378204490248044059404; + x[11] = -0.38838590160823294306135146; + x[12] = -0.29471806998170161661790390; + x[13] = -0.19812119933557062877241300; + x[14] = -0.09955531215234152032517479; + x[15] = 0.00000000000000000000000000; + x[16] = 0.09955531215234152032517479; + x[17] = 0.19812119933557062877241300; + x[18] = 0.29471806998170161661790390; + x[19] = 0.38838590160823294306135146; + x[20] = 0.47819378204490248044059404; + x[21] = 0.56324916140714926272094492; + x[22] = 0.64270672292426034618441820; + x[23] = 0.71577678458685328390597087; + x[24] = 0.78173314841662494040636002; + x[25] = 0.83992032014626734008690454; + x[26] = 0.88976002994827104337419201; + x[27] = 0.93075699789664816495694576; + x[28] = 0.96250392509294966178905240; + x[29] = 0.98468590966515248400246517; + x[30] = 0.99708748181947707405562655; + } + else if ( n == 32 ) + { + x[0] = -0.99726386184948156354498113; + x[1] = -0.98561151154526833540017504; + x[2] = -0.96476225558750643077381193; + x[3] = -0.93490607593773968917091913; + x[4] = -0.89632115576605212396530724; + x[5] = -0.84936761373256997013369300; + x[6] = -0.79448379596794240696309730; + x[7] = -0.73218211874028968038742667; + x[8] = -0.66304426693021520097511517; + x[9] = -0.58771575724076232904074548; + x[10] = -0.50689990893222939002374747; + x[11] = -0.42135127613063534536411944; + x[12] = -0.33186860228212764977991681; + x[13] = -0.23928736225213707454460321; + x[14] = -0.14447196158279649348518637; + x[15] = -0.04830766568773831623481257; + x[16] = 0.04830766568773831623481257; + x[17] = 0.14447196158279649348518637; + x[18] = 0.23928736225213707454460321; + x[19] = 0.33186860228212764977991681; + x[20] = 0.42135127613063534536411944; + x[21] = 0.50689990893222939002374747; + x[22] = 0.58771575724076232904074548; + x[23] = 0.66304426693021520097511517; + x[24] = 0.73218211874028968038742667; + x[25] = 0.79448379596794240696309730; + x[26] = 0.84936761373256997013369300; + x[27] = 0.89632115576605212396530724; + x[28] = 0.93490607593773968917091913; + x[29] = 0.96476225558750643077381193; + x[30] = 0.98561151154526833540017504; + x[31] = 0.99726386184948156354498113; + } + else if ( n == 33 ) + { + x[0] = -0.99742469424645521726616802; + x[1] = -0.98645572623064248811037570; + x[2] = -0.96682290968999276892837771; + x[3] = -0.93869437261116835035583512; + x[4] = -0.90231676774343358304053133; + x[5] = -0.85800965267650406464306148; + x[6] = -0.80616235627416658979620087; + x[7] = -0.74723049644956215785905512; + x[8] = -0.68173195996974278626821595; + x[9] = -0.61024234583637902730728751; + x[10] = -0.53338990478634764354889426; + x[11] = -0.45185001727245069572599328; + x[12] = -0.36633925774807334107022062; + x[13] = -0.27760909715249702940324807; + x[14] = -0.18643929882799157233579876; + x[15] = -0.09363106585473338567074292; + x[16] = 0.00000000000000000000000000; + x[17] = 0.09363106585473338567074292; + x[18] = 0.18643929882799157233579876; + x[19] = 0.27760909715249702940324807; + x[20] = 0.36633925774807334107022062; + x[21] = 0.45185001727245069572599328; + x[22] = 0.53338990478634764354889426; + x[23] = 0.61024234583637902730728751; + x[24] = 0.68173195996974278626821595; + x[25] = 0.74723049644956215785905512; + x[26] = 0.80616235627416658979620087; + x[27] = 0.85800965267650406464306148; + x[28] = 0.90231676774343358304053133; + x[29] = 0.93869437261116835035583512; + x[30] = 0.96682290968999276892837771; + x[31] = 0.98645572623064248811037570; + x[32] = 0.99742469424645521726616802; + } + else + { + std::cerr << "\n"; + std::cerr << "LEGENDRE_LOOKUP_POINTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::cerr << " Legal values are 1 through 33.\n"; + std::exit ( 1 ); + } + return; +} +//****************************************************************************80 + +void legendre_lookup_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_LOOKUP_WEIGHTS looks up weights for Gauss-Legendre quadrature. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 April 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Vladimir Krylov, +// Approximate Calculation of Integrals, +// Dover, 2006, +// ISBN: 0486445798. +// LC: QA311.K713. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Stephen Wolfram, +// The Mathematica Book, +// Fourth Edition, +// Cambridge University Press, 1999, +// ISBN: 0-521-64314-7, +// LC: QA76.95.W65. +// +// Daniel Zwillinger, editor, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, +// CRC Press, 1996, +// ISBN: 0-8493-2479-3, +// LC: QA47.M315. +// +// Parameters: +// +// Input, int N, the order. +// N must be between 1 and 33. +// +// Output, double W[N], the weights. +// +{ + if ( n == 1 ) + { + w[0] = 2.000000000000000000000000000000; + } + else if ( n == 2 ) + { + w[0] = 1.000000000000000000000000000000; + w[1] = 1.000000000000000000000000000000; + } + else if ( n == 3 ) + { + w[0] = 0.555555555555555555555555555556; + w[1] = 0.888888888888888888888888888889; + w[2] = 0.555555555555555555555555555556; + } + else if ( n == 4 ) + { + w[0] = 0.347854845137453857373063949222; + w[1] = 0.652145154862546142626936050778; + w[2] = 0.652145154862546142626936050778; + w[3] = 0.347854845137453857373063949222; + } + else if ( n == 5 ) + { + w[0] = 0.236926885056189087514264040720; + w[1] = 0.478628670499366468041291514836; + w[2] = 0.568888888888888888888888888889; + w[3] = 0.478628670499366468041291514836; + w[4] = 0.236926885056189087514264040720; + } + else if ( n == 6 ) + { + w[0] = 0.171324492379170345040296142173; + w[1] = 0.360761573048138607569833513838; + w[2] = 0.467913934572691047389870343990; + w[3] = 0.467913934572691047389870343990; + w[4] = 0.360761573048138607569833513838; + w[5] = 0.171324492379170345040296142173; + } + else if ( n == 7 ) + { + w[0] = 0.129484966168869693270611432679; + w[1] = 0.279705391489276667901467771424; + w[2] = 0.381830050505118944950369775489; + w[3] = 0.417959183673469387755102040816; + w[4] = 0.381830050505118944950369775489; + w[5] = 0.279705391489276667901467771424; + w[6] = 0.129484966168869693270611432679; + } + else if ( n == 8 ) + { + w[0] = 0.101228536290376259152531354310; + w[1] = 0.222381034453374470544355994426; + w[2] = 0.313706645877887287337962201987; + w[3] = 0.362683783378361982965150449277; + w[4] = 0.362683783378361982965150449277; + w[5] = 0.313706645877887287337962201987; + w[6] = 0.222381034453374470544355994426; + w[7] = 0.101228536290376259152531354310; + } + else if ( n == 9 ) + { + w[0] = 0.081274388361574411971892158111; + w[1] = 0.18064816069485740405847203124; + w[2] = 0.26061069640293546231874286942; + w[3] = 0.31234707704000284006863040658; + w[4] = 0.33023935500125976316452506929; + w[5] = 0.31234707704000284006863040658; + w[6] = 0.26061069640293546231874286942; + w[7] = 0.18064816069485740405847203124; + w[8] = 0.081274388361574411971892158111; + } + else if ( n == 10 ) + { + w[0] = 0.066671344308688137593568809893; + w[1] = 0.14945134915058059314577633966; + w[2] = 0.21908636251598204399553493423; + w[3] = 0.26926671930999635509122692157; + w[4] = 0.29552422471475287017389299465; + w[5] = 0.29552422471475287017389299465; + w[6] = 0.26926671930999635509122692157; + w[7] = 0.21908636251598204399553493423; + w[8] = 0.14945134915058059314577633966; + w[9] = 0.066671344308688137593568809893; + } + else if ( n == 11 ) + { + w[0] = 0.055668567116173666482753720443; + w[1] = 0.12558036946490462463469429922; + w[2] = 0.18629021092773425142609764143; + w[3] = 0.23319376459199047991852370484; + w[4] = 0.26280454451024666218068886989; + w[5] = 0.27292508677790063071448352834; + w[6] = 0.26280454451024666218068886989; + w[7] = 0.23319376459199047991852370484; + w[8] = 0.18629021092773425142609764143; + w[9] = 0.12558036946490462463469429922; + w[10] = 0.055668567116173666482753720443; + } + else if ( n == 12 ) + { + w[0] = 0.047175336386511827194615961485; + w[1] = 0.10693932599531843096025471819; + w[2] = 0.16007832854334622633465252954; + w[3] = 0.20316742672306592174906445581; + w[4] = 0.23349253653835480876084989892; + w[5] = 0.24914704581340278500056243604; + w[6] = 0.24914704581340278500056243604; + w[7] = 0.23349253653835480876084989892; + w[8] = 0.20316742672306592174906445581; + w[9] = 0.16007832854334622633465252954; + w[10] = 0.10693932599531843096025471819; + w[11] = 0.047175336386511827194615961485; + } + else if ( n == 13 ) + { + w[0] = 0.040484004765315879520021592201; + w[1] = 0.092121499837728447914421775954; + w[2] = 0.13887351021978723846360177687; + w[3] = 0.17814598076194573828004669200; + w[4] = 0.20781604753688850231252321931; + w[5] = 0.22628318026289723841209018604; + w[6] = 0.23255155323087391019458951527; + w[7] = 0.22628318026289723841209018604; + w[8] = 0.20781604753688850231252321931; + w[9] = 0.17814598076194573828004669200; + w[10] = 0.13887351021978723846360177687; + w[11] = 0.092121499837728447914421775954; + w[12] = 0.040484004765315879520021592201; + } + else if ( n == 14 ) + { + w[0] = 0.035119460331751863031832876138; + w[1] = 0.08015808715976020980563327706; + w[2] = 0.12151857068790318468941480907; + w[3] = 0.15720316715819353456960193862; + w[4] = 0.18553839747793781374171659013; + w[5] = 0.20519846372129560396592406566; + w[6] = 0.21526385346315779019587644332; + w[7] = 0.21526385346315779019587644332; + w[8] = 0.20519846372129560396592406566; + w[9] = 0.18553839747793781374171659013; + w[10] = 0.15720316715819353456960193862; + w[11] = 0.12151857068790318468941480907; + w[12] = 0.08015808715976020980563327706; + w[13] = 0.035119460331751863031832876138; + } + else if ( n == 15 ) + { + w[0] = 0.030753241996117268354628393577; + w[1] = 0.070366047488108124709267416451; + w[2] = 0.107159220467171935011869546686; + w[3] = 0.13957067792615431444780479451; + w[4] = 0.16626920581699393355320086048; + w[5] = 0.18616100001556221102680056187; + w[6] = 0.19843148532711157645611832644; + w[7] = 0.20257824192556127288062019997; + w[8] = 0.19843148532711157645611832644; + w[9] = 0.18616100001556221102680056187; + w[10] = 0.16626920581699393355320086048; + w[11] = 0.13957067792615431444780479451; + w[12] = 0.107159220467171935011869546686; + w[13] = 0.070366047488108124709267416451; + w[14] = 0.030753241996117268354628393577; + } + else if ( n == 16 ) + { + w[0] = 0.027152459411754094851780572456; + w[1] = 0.062253523938647892862843836994; + w[2] = 0.09515851168249278480992510760; + w[3] = 0.12462897125553387205247628219; + w[4] = 0.14959598881657673208150173055; + w[5] = 0.16915651939500253818931207903; + w[6] = 0.18260341504492358886676366797; + w[7] = 0.18945061045506849628539672321; + w[8] = 0.18945061045506849628539672321; + w[9] = 0.18260341504492358886676366797; + w[10] = 0.16915651939500253818931207903; + w[11] = 0.14959598881657673208150173055; + w[12] = 0.12462897125553387205247628219; + w[13] = 0.09515851168249278480992510760; + w[14] = 0.062253523938647892862843836994; + w[15] = 0.027152459411754094851780572456; + } + else if ( n == 17 ) + { + w[0] = 0.024148302868547931960110026288; + w[1] = 0.055459529373987201129440165359; + w[2] = 0.085036148317179180883535370191; + w[3] = 0.111883847193403971094788385626; + w[4] = 0.13513636846852547328631998170; + w[5] = 0.15404576107681028808143159480; + w[6] = 0.16800410215645004450997066379; + w[7] = 0.17656270536699264632527099011; + w[8] = 0.17944647035620652545826564426; + w[9] = 0.17656270536699264632527099011; + w[10] = 0.16800410215645004450997066379; + w[11] = 0.15404576107681028808143159480; + w[12] = 0.13513636846852547328631998170; + w[13] = 0.111883847193403971094788385626; + w[14] = 0.085036148317179180883535370191; + w[15] = 0.055459529373987201129440165359; + w[16] = 0.024148302868547931960110026288; + } + else if ( n == 18 ) + { + w[0] = 0.021616013526483310313342710266; + w[1] = 0.049714548894969796453334946203; + w[2] = 0.07642573025488905652912967762; + w[3] = 0.10094204410628716556281398492; + w[4] = 0.12255520671147846018451912680; + w[5] = 0.14064291467065065120473130375; + w[6] = 0.15468467512626524492541800384; + w[7] = 0.16427648374583272298605377647; + w[8] = 0.16914238296314359184065647013; + w[9] = 0.16914238296314359184065647013; + w[10] = 0.16427648374583272298605377647; + w[11] = 0.15468467512626524492541800384; + w[12] = 0.14064291467065065120473130375; + w[13] = 0.12255520671147846018451912680; + w[14] = 0.10094204410628716556281398492; + w[15] = 0.07642573025488905652912967762; + w[16] = 0.049714548894969796453334946203; + w[17] = 0.021616013526483310313342710266; + } + else if ( n == 19 ) + { + w[0] = 0.019461788229726477036312041464; + w[1] = 0.044814226765699600332838157402; + w[2] = 0.069044542737641226580708258006; + w[3] = 0.091490021622449999464462094124; + w[4] = 0.111566645547333994716023901682; + w[5] = 0.12875396253933622767551578486; + w[6] = 0.14260670217360661177574610944; + w[7] = 0.15276604206585966677885540090; + w[8] = 0.15896884339395434764995643946; + w[9] = 0.16105444984878369597916362532; + w[10] = 0.15896884339395434764995643946; + w[11] = 0.15276604206585966677885540090; + w[12] = 0.14260670217360661177574610944; + w[13] = 0.12875396253933622767551578486; + w[14] = 0.111566645547333994716023901682; + w[15] = 0.091490021622449999464462094124; + w[16] = 0.069044542737641226580708258006; + w[17] = 0.044814226765699600332838157402; + w[18] = 0.019461788229726477036312041464; + } + else if ( n == 20 ) + { + w[0] = 0.017614007139152118311861962352; + w[1] = 0.040601429800386941331039952275; + w[2] = 0.062672048334109063569506535187; + w[3] = 0.08327674157670474872475814322; + w[4] = 0.10193011981724043503675013548; + w[5] = 0.11819453196151841731237737771; + w[6] = 0.13168863844917662689849449975; + w[7] = 0.14209610931838205132929832507; + w[8] = 0.14917298647260374678782873700; + w[9] = 0.15275338713072585069808433195; + w[10] = 0.15275338713072585069808433195; + w[11] = 0.14917298647260374678782873700; + w[12] = 0.14209610931838205132929832507; + w[13] = 0.13168863844917662689849449975; + w[14] = 0.11819453196151841731237737771; + w[15] = 0.10193011981724043503675013548; + w[16] = 0.08327674157670474872475814322; + w[17] = 0.062672048334109063569506535187; + w[18] = 0.040601429800386941331039952275; + w[19] = 0.017614007139152118311861962352; + } + else if ( n == 21 ) + { + w[ 0] = 0.016017228257774333324224616858; + w[ 1] = 0.036953789770852493799950668299; + w[ 2] = 0.057134425426857208283635826472; + w[ 3] = 0.076100113628379302017051653300; + w[ 4] = 0.093444423456033861553289741114; + w[ 5] = 0.108797299167148377663474578070; + w[ 6] = 0.12183141605372853419536717713; + w[ 7] = 0.13226893863333746178105257450; + w[ 8] = 0.13988739479107315472213342387; + w[9] = 0.14452440398997005906382716655; + w[10] = 0.14608113364969042719198514768; + w[11] = 0.14452440398997005906382716655; + w[12] = 0.13988739479107315472213342387; + w[13] = 0.13226893863333746178105257450; + w[14] = 0.12183141605372853419536717713; + w[15] = 0.108797299167148377663474578070; + w[16] = 0.093444423456033861553289741114; + w[17] = 0.076100113628379302017051653300; + w[18] = 0.057134425426857208283635826472; + w[19] = 0.036953789770852493799950668299; + w[20] = 0.016017228257774333324224616858; + } + else if ( n == 22 ) + { + w[0] = 0.014627995298272200684991098047; + w[1] = 0.033774901584814154793302246866; + w[2] = 0.052293335152683285940312051273; + w[3] = 0.06979646842452048809496141893; + w[4] = 0.08594160621706772741444368137; + w[5] = 0.10041414444288096493207883783; + w[6] = 0.11293229608053921839340060742; + w[7] = 0.12325237681051242428556098615; + w[8] = 0.13117350478706237073296499253; + w[9] = 0.13654149834601517135257383123; + w[10] = 0.13925187285563199337541024834; + w[11] = 0.13925187285563199337541024834; + w[12] = 0.13654149834601517135257383123; + w[13] = 0.13117350478706237073296499253; + w[14] = 0.12325237681051242428556098615; + w[15] = 0.11293229608053921839340060742; + w[16] = 0.10041414444288096493207883783; + w[17] = 0.08594160621706772741444368137; + w[18] = 0.06979646842452048809496141893; + w[19] = 0.052293335152683285940312051273; + w[20] = 0.033774901584814154793302246866; + w[21] = 0.014627995298272200684991098047; + } + else if ( n == 23 ) + { + w[0] = 0.013411859487141772081309493459; + w[1] = 0.030988005856979444310694219642; + w[2] = 0.048037671731084668571641071632; + w[3] = 0.064232421408525852127169615159; + w[4] = 0.079281411776718954922892524742; + w[5] = 0.092915766060035147477018617370; + w[6] = 0.104892091464541410074086185015; + w[7] = 0.11499664022241136494164351293; + w[8] = 0.12304908430672953046757840067; + w[9] = 0.12890572218808214997859533940; + w[10] = 0.13246203940469661737164246470; + w[11] = 0.13365457218610617535145711055; + w[12] = 0.13246203940469661737164246470; + w[13] = 0.12890572218808214997859533940; + w[14] = 0.12304908430672953046757840067; + w[15] = 0.11499664022241136494164351293; + w[16] = 0.104892091464541410074086185015; + w[17] = 0.092915766060035147477018617370; + w[18] = 0.079281411776718954922892524742; + w[19] = 0.064232421408525852127169615159; + w[20] = 0.048037671731084668571641071632; + w[21] = 0.030988005856979444310694219642; + w[22] = 0.013411859487141772081309493459; + } + else if ( n == 24 ) + { + w[0] = 0.012341229799987199546805667070; + w[1] = 0.028531388628933663181307815952; + w[2] = 0.044277438817419806168602748211; + w[3] = 0.059298584915436780746367758500; + w[4] = 0.07334648141108030573403361525; + w[5] = 0.08619016153195327591718520298; + w[6] = 0.09761865210411388826988066446; + w[7] = 0.10744427011596563478257734245; + w[8] = 0.11550566805372560135334448391; + w[9] = 0.12167047292780339120446315348; + w[10] = 0.12583745634682829612137538251; + w[11] = 0.12793819534675215697405616522; + w[12] = 0.12793819534675215697405616522; + w[13] = 0.12583745634682829612137538251; + w[14] = 0.12167047292780339120446315348; + w[15] = 0.11550566805372560135334448391; + w[16] = 0.10744427011596563478257734245; + w[17] = 0.09761865210411388826988066446; + w[18] = 0.08619016153195327591718520298; + w[19] = 0.07334648141108030573403361525; + w[20] = 0.059298584915436780746367758500; + w[21] = 0.044277438817419806168602748211; + w[22] = 0.028531388628933663181307815952; + w[23] = 0.012341229799987199546805667070; + } + else if ( n == 25 ) + { + w[0] = 0.0113937985010262879479029641132; + w[1] = 0.026354986615032137261901815295; + w[2] = 0.040939156701306312655623487712; + w[3] = 0.054904695975835191925936891541; + w[4] = 0.068038333812356917207187185657; + w[5] = 0.080140700335001018013234959669; + w[6] = 0.091028261982963649811497220703; + w[7] = 0.100535949067050644202206890393; + w[8] = 0.108519624474263653116093957050; + w[9] = 0.11485825914571164833932554587; + w[10] = 0.11945576353578477222817812651; + w[11] = 0.12224244299031004168895951895; + w[12] = 0.12317605372671545120390287308; + w[13] = 0.12224244299031004168895951895; + w[14] = 0.11945576353578477222817812651; + w[15] = 0.11485825914571164833932554587; + w[16] = 0.108519624474263653116093957050; + w[17] = 0.100535949067050644202206890393; + w[18] = 0.091028261982963649811497220703; + w[19] = 0.080140700335001018013234959669; + w[20] = 0.068038333812356917207187185657; + w[21] = 0.054904695975835191925936891541; + w[22] = 0.040939156701306312655623487712; + w[23] = 0.026354986615032137261901815295; + w[24] = 0.0113937985010262879479029641132; + } + else if ( n == 26 ) + { + w[0] = 0.010551372617343007155651187685; + w[1] = 0.024417851092631908789615827520; + w[2] = 0.037962383294362763950303141249; + w[3] = 0.050975825297147811998319900724; + w[4] = 0.063274046329574835539453689907; + w[5] = 0.07468414976565974588707579610; + w[6] = 0.08504589431348523921044776508; + w[7] = 0.09421380035591414846366488307; + w[8] = 0.10205916109442542323841407025; + w[9] = 0.10847184052857659065657942673; + w[10] = 0.11336181654631966654944071844; + w[11] = 0.11666044348529658204466250754; + w[12] = 0.11832141527926227651637108570; + w[13] = 0.11832141527926227651637108570; + w[14] = 0.11666044348529658204466250754; + w[15] = 0.11336181654631966654944071844; + w[16] = 0.10847184052857659065657942673; + w[17] = 0.10205916109442542323841407025; + w[18] = 0.09421380035591414846366488307; + w[19] = 0.08504589431348523921044776508; + w[20] = 0.07468414976565974588707579610; + w[21] = 0.063274046329574835539453689907; + w[22] = 0.050975825297147811998319900724; + w[23] = 0.037962383294362763950303141249; + w[24] = 0.024417851092631908789615827520; + w[25] = 0.010551372617343007155651187685; + } + else if ( n == 27 ) + { + w[0] = 0.0097989960512943602611500550912; + w[1] = 0.022686231596180623196034206447; + w[2] = 0.035297053757419711022578289305; + w[3] = 0.047449412520615062704096710114; + w[4] = 0.058983536859833599110300833720; + w[5] = 0.069748823766245592984322888357; + w[6] = 0.079604867773057771263074959010; + w[7] = 0.088423158543756950194322802854; + w[8] = 0.096088727370028507565652646558; + w[9] = 0.102501637817745798671247711533; + w[10] = 0.107578285788533187212162984427; + w[11] = 0.111252488356845192672163096043; + w[12] = 0.113476346108965148620369948092; + w[13] = 0.11422086737895698904504573690; + w[14] = 0.113476346108965148620369948092; + w[15] = 0.111252488356845192672163096043; + w[16] = 0.107578285788533187212162984427; + w[17] = 0.102501637817745798671247711533; + w[18] = 0.096088727370028507565652646558; + w[19] = 0.088423158543756950194322802854; + w[20] = 0.079604867773057771263074959010; + w[21] = 0.069748823766245592984322888357; + w[22] = 0.058983536859833599110300833720; + w[23] = 0.047449412520615062704096710114; + w[24] = 0.035297053757419711022578289305; + w[25] = 0.022686231596180623196034206447; + w[26] = 0.0097989960512943602611500550912; + } + else if ( n == 28 ) + { + w[0] = 0.009124282593094517738816153923; + w[1] = 0.021132112592771259751500380993; + w[2] = 0.032901427782304379977630819171; + w[3] = 0.044272934759004227839587877653; + w[4] = 0.055107345675716745431482918227; + w[5] = 0.06527292396699959579339756678; + w[6] = 0.07464621423456877902393188717; + w[7] = 0.08311341722890121839039649824; + w[8] = 0.09057174439303284094218603134; + w[9] = 0.09693065799792991585048900610; + w[10] = 0.10211296757806076981421663851; + w[11] = 0.10605576592284641791041643700; + w[12] = 0.10871119225829413525357151930; + w[13] = 0.11004701301647519628237626560; + w[14] = 0.11004701301647519628237626560; + w[15] = 0.10871119225829413525357151930; + w[16] = 0.10605576592284641791041643700; + w[17] = 0.10211296757806076981421663851; + w[18] = 0.09693065799792991585048900610; + w[19] = 0.09057174439303284094218603134; + w[20] = 0.08311341722890121839039649824; + w[21] = 0.07464621423456877902393188717; + w[22] = 0.06527292396699959579339756678; + w[23] = 0.055107345675716745431482918227; + w[24] = 0.044272934759004227839587877653; + w[25] = 0.032901427782304379977630819171; + w[26] = 0.021132112592771259751500380993; + w[27] = 0.009124282593094517738816153923; + } + else if ( n == 29 ) + { + w[0] = 0.0085169038787464096542638133022; + w[1] = 0.019732085056122705983859801640; + w[2] = 0.030740492202093622644408525375; + w[3] = 0.041402062518682836104830010114; + w[4] = 0.051594826902497923912594381180; + w[5] = 0.061203090657079138542109848024; + w[6] = 0.070117933255051278569581486949; + w[7] = 0.078238327135763783828144888660; + w[8] = 0.085472257366172527545344849297; + w[9] = 0.091737757139258763347966411077; + w[10] = 0.096963834094408606301900074883; + w[11] = 0.101091273759914966121820546907; + w[12] = 0.104073310077729373913328471285; + w[13] = 0.105876155097320941406591327852; + w[14] = 0.10647938171831424424651112691; + w[15] = 0.105876155097320941406591327852; + w[16] = 0.104073310077729373913328471285; + w[17] = 0.101091273759914966121820546907; + w[18] = 0.096963834094408606301900074883; + w[19] = 0.091737757139258763347966411077; + w[20] = 0.085472257366172527545344849297; + w[21] = 0.078238327135763783828144888660; + w[22] = 0.070117933255051278569581486949; + w[23] = 0.061203090657079138542109848024; + w[24] = 0.051594826902497923912594381180; + w[25] = 0.041402062518682836104830010114; + w[26] = 0.030740492202093622644408525375; + w[27] = 0.019732085056122705983859801640; + w[28] = 0.0085169038787464096542638133022; + } + else if ( n == 30 ) + { + w[0] = 0.007968192496166605615465883475; + w[1] = 0.018466468311090959142302131912; + w[2] = 0.028784707883323369349719179611; + w[3] = 0.038799192569627049596801936446; + w[4] = 0.048402672830594052902938140423; + w[5] = 0.057493156217619066481721689402; + w[6] = 0.06597422988218049512812851512; + w[7] = 0.07375597473770520626824385002; + w[8] = 0.08075589522942021535469493846; + w[9] = 0.08689978720108297980238753072; + w[10] = 0.09212252223778612871763270709; + w[11] = 0.09636873717464425963946862635; + w[12] = 0.09959342058679526706278028210; + w[13] = 0.10176238974840550459642895217; + w[14] = 0.10285265289355884034128563671; + w[15] = 0.10285265289355884034128563671; + w[16] = 0.10176238974840550459642895217; + w[17] = 0.09959342058679526706278028210; + w[18] = 0.09636873717464425963946862635; + w[19] = 0.09212252223778612871763270709; + w[20] = 0.08689978720108297980238753072; + w[21] = 0.08075589522942021535469493846; + w[22] = 0.07375597473770520626824385002; + w[23] = 0.06597422988218049512812851512; + w[24] = 0.057493156217619066481721689402; + w[25] = 0.048402672830594052902938140423; + w[26] = 0.038799192569627049596801936446; + w[27] = 0.028784707883323369349719179611; + w[28] = 0.018466468311090959142302131912; + w[29] = 0.007968192496166605615465883475; + } + else if ( n == 31 ) + { + w[0] = 0.0074708315792487758586968750322; + w[1] = 0.017318620790310582463157996087; + w[2] = 0.027009019184979421800608708092; + w[3] = 0.036432273912385464024392010468; + w[4] = 0.045493707527201102902315857895; + w[5] = 0.054103082424916853711666259087; + w[6] = 0.062174786561028426910343543687; + w[7] = 0.069628583235410366167756126255; + w[8] = 0.076390386598776616426357674901; + w[9] = 0.082392991761589263903823367432; + w[10] = 0.087576740608477876126198069695; + w[11] = 0.091890113893641478215362871607; + w[12] = 0.095290242912319512807204197488; + w[13] = 0.097743335386328725093474010979; + w[14] = 0.099225011226672307874875514429; + w[15] = 0.09972054479342645142753383373; + w[16] = 0.099225011226672307874875514429; + w[17] = 0.097743335386328725093474010979; + w[18] = 0.095290242912319512807204197488; + w[19] = 0.091890113893641478215362871607; + w[20] = 0.087576740608477876126198069695; + w[21] = 0.082392991761589263903823367432; + w[22] = 0.076390386598776616426357674901; + w[23] = 0.069628583235410366167756126255; + w[24] = 0.062174786561028426910343543687; + w[25] = 0.054103082424916853711666259087; + w[26] = 0.045493707527201102902315857895; + w[27] = 0.036432273912385464024392010468; + w[28] = 0.027009019184979421800608708092; + w[29] = 0.017318620790310582463157996087; + w[30] = 0.0074708315792487758586968750322; + } + else if ( n == 32 ) + { + w[0] = 0.007018610009470096600407063739; + w[1] = 0.016274394730905670605170562206; + w[2] = 0.025392065309262059455752589789; + w[3] = 0.034273862913021433102687732252; + w[4] = 0.042835898022226680656878646606; + w[5] = 0.050998059262376176196163244690; + w[6] = 0.058684093478535547145283637300; + w[7] = 0.06582222277636184683765006371; + w[8] = 0.07234579410884850622539935648; + w[9] = 0.07819389578707030647174091883; + w[10] = 0.08331192422694675522219907460; + w[11] = 0.08765209300440381114277146275; + w[12] = 0.09117387869576388471286857711; + w[13] = 0.09384439908080456563918023767; + w[14] = 0.09563872007927485941908200220; + w[15] = 0.09654008851472780056676483006; + w[16] = 0.09654008851472780056676483006; + w[17] = 0.09563872007927485941908200220; + w[18] = 0.09384439908080456563918023767; + w[19] = 0.09117387869576388471286857711; + w[20] = 0.08765209300440381114277146275; + w[21] = 0.08331192422694675522219907460; + w[22] = 0.07819389578707030647174091883; + w[23] = 0.07234579410884850622539935648; + w[24] = 0.06582222277636184683765006371; + w[25] = 0.058684093478535547145283637300; + w[26] = 0.050998059262376176196163244690; + w[27] = 0.042835898022226680656878646606; + w[28] = 0.034273862913021433102687732252; + w[29] = 0.025392065309262059455752589789; + w[30] = 0.016274394730905670605170562206; + w[31] = 0.007018610009470096600407063739; + } + else if ( n == 33 ) + { + w[0] = 0.0066062278475873780586492352085; + w[1] = 0.015321701512934676127945768534; + w[2] = 0.023915548101749480350533257529; + w[3] = 0.032300358632328953281561447250; + w[4] = 0.040401541331669591563409790527; + w[5] = 0.048147742818711695670146880138; + w[6] = 0.055470846631663561284944495439; + w[7] = 0.062306482530317480031627725771; + w[8] = 0.068594572818656712805955073015; + w[9] = 0.074279854843954149342472175919; + w[10] = 0.079312364794886738363908384942; + w[11] = 0.083647876067038707613928014518; + w[12] = 0.087248287618844337607281670945; + w[13] = 0.090081958660638577239743705500; + w[14] = 0.092123986643316846213240977717; + w[15] = 0.093356426065596116160999126274; + w[16] = 0.09376844616020999656730454155; + w[17] = 0.093356426065596116160999126274; + w[18] = 0.092123986643316846213240977717; + w[19] = 0.090081958660638577239743705500; + w[20] = 0.087248287618844337607281670945; + w[21] = 0.083647876067038707613928014518; + w[22] = 0.079312364794886738363908384942; + w[23] = 0.074279854843954149342472175919; + w[24] = 0.068594572818656712805955073015; + w[25] = 0.062306482530317480031627725771; + w[26] = 0.055470846631663561284944495439; + w[27] = 0.048147742818711695670146880138; + w[28] = 0.040401541331669591563409790527; + w[29] = 0.032300358632328953281561447250; + w[30] = 0.023915548101749480350533257529; + w[31] = 0.015321701512934676127945768534; + w[32] = 0.0066062278475873780586492352085; + } + else + { + std::cerr << "\n"; + std::cerr << "LEGENDRE_LOOKUP_WEIGHTS - Fatal error!\n"; + std::cerr << " Illegal value of N = " << n << "\n"; + std::cerr << " Legal values are 1 through 33.\n"; + std::exit ( 1 ); + } + return; +} +//****************************************************************************80 + +double *legendre_zeros ( int order ) + +//****************************************************************************80 +// +// Purpose: +// +// LEGENDRE_ZEROS returns the zeros of the Legendre polynomial of degree N. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 June 2011 +// +// Author: +// +// Original FORTRAN77 version by Philip Davis, Philip Rabinowitz. +// C++ version by John Burkardt. +// +// Reference: +// +// Philip Davis, Philip Rabinowitz, +// Methods of Numerical Integration, +// Second Edition, +// Dover, 2007, +// ISBN: 0486453391, +// LC: QA299.3.D28. +// +// Parameters: +// +// Input, int ORDER, the order. +// ORDER must be greater than 0. +// +// Output, double LEGENDRE_ZEROS[ORDER], the zeros. +// +{ + double d1; + double d2pn; + double d3pn; + double d4pn; + double dp; + double dpn; + double e1; + double fx; + double h; + int i; + int iback; + int k; + int m; + int mp1mi; + int ncopy; + int nmove; + double p; + double pi = 3.141592653589793; + double pk; + double pkm1; + double pkp1; + double t; + double u; + double v; + double x0; + double *xtab; + double xtemp; + + xtab = new double[order]; + + e1 = ( double ) ( order * ( order + 1 ) ); + + m = ( order + 1 ) / 2; + + for ( i = 1; i <= m; i++ ) + { + mp1mi = m + 1 - i; + + t = ( double ) ( 4 * i - 1 ) * pi / ( double ) ( 4 * order + 2 ); + + x0 = std::cos ( t ) * ( 1.0 - ( 1.0 - 1.0 / ( double ) ( order ) ) + / ( double ) ( 8 * order * order ) ); + + pkm1 = 1.0; + pk = x0; + + for ( k = 2; k <= order; k++ ) + { + pkp1 = 2.0 * x0 * pk - pkm1 - ( x0 * pk - pkm1 ) / ( double ) ( k ); + pkm1 = pk; + pk = pkp1; + } + + d1 = ( double ) ( order ) * ( pkm1 - x0 * pk ); + + dpn = d1 / ( 1.0 - x0 * x0 ); + + d2pn = ( 2.0 * x0 * dpn - e1 * pk ) / ( 1.0 - x0 * x0 ); + + d3pn = ( 4.0 * x0 * d2pn + ( 2.0 - e1 ) * dpn ) / ( 1.0 - x0 * x0 ); + + d4pn = ( 6.0 * x0 * d3pn + ( 6.0 - e1 ) * d2pn ) / ( 1.0 - x0 * x0 ); + + u = pk / dpn; + v = d2pn / dpn; +// +// Initial approximation H: +// + h = - u * ( 1.0 + 0.5 * u * ( v + u * ( v * v - d3pn / ( 3.0 * dpn ) ) ) ); +// +// Refine H using one step of Newton's method: +// + p = pk + h * ( dpn + 0.5 * h * ( d2pn + h / 3.0 + * ( d3pn + 0.25 * h * d4pn ) ) ); + + dp = dpn + h * ( d2pn + 0.5 * h * ( d3pn + h * d4pn / 3.0 ) ); + + h = h - p / dp; + + xtemp = x0 + h; + + xtab[mp1mi-1] = xtemp; + + fx = d1 - h * e1 * ( pk + 0.5 * h * ( dpn + h / 3.0 + * ( d2pn + 0.25 * h * ( d3pn + 0.2 * h * d4pn ) ) ) ); + } + + if ( ( order % 2 ) == 1 ) + { + xtab[0] = 0.0; + } +// +// Shift the data up. +// + nmove = ( order + 1 ) / 2; + ncopy = order - nmove; + + for ( i = 1; i <= nmove; i++ ) + { + iback = order + 1 - i; + xtab[iback-1] = xtab[iback-ncopy-1]; + } +// +// Reflect values for the negative abscissas. +// + for ( i = 1; i <= order - nmove; i++ ) + { + xtab[i-1] = - xtab[order-i]; + } + + return xtab; +} +//****************************************************************************80 + +void level_growth_to_order ( int dim_num, int level[], int rule[], + int growth[], int order[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_GROWTH_TO_ORDER: convert Level and Growth to Order. +// +// Discussion: +// +// This function is given level, rule, and growth information +// for each dimension of a quadrature rule, and determines the +// corresponding order of the rule in each dimension. +// +// This is a revised version of LEVEL_GROWTH_TO_ORDER. +// +// In particular, it revises the interpretation of the RULE vector as +// far as the values 10, 11, and 12 are concerned. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 16 October 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int DIM_NUM, the spatial dimension. +// +// Input, int LEVEL[DIM_NUM], the 1D levels. +// +// Input, int RULE[DIM_NUM], the rule in each dimension. +// 1, "CC", Clenshaw Curtis, Closed Fully Nested. +// 2, "F2", Fejer Type 2, Open Fully Nested. +// 3, "GP", Gauss Patterson, Open Fully Nested. +// 4, "GL", Gauss Legendre, Open Weakly Nested. +// 5, "GH", Gauss Hermite, Open Weakly Nested. +// 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested. +// 7, "LG", Gauss Laguerre, Open Non Nested. +// 8, "GLG", Generalized Gauss Laguerre, Open Non Nested. +// 9, "GJ", Gauss Jacobi, Open Non Nested. +// 10, "HGK", Hermite Genz-Keister, Open Fully Nested. +// 11, "UO", User supplied Open, presumably Non Nested. +// 12, "UC", User supplied Closed, presumably Non Nested. +// +// Input, int GROWTH[DIM_NUM], the desired growth in each dimension. +// 0, "DF", default growth associated with this quadrature rule; +// 1, "SL", slow linear, L+1; +// 2 "SO", slow linear odd, O=1+2((L+1)/2) +// 3, "ML", moderate linear, 2L+1; +// 4, "SE", slow exponential; +// 5, "ME", moderate exponential; +// 6, "FE", full exponential. +// +// Output, int ORDER[DIM_NUM], the 1D orders (number of points). +// +{ + int dim; + int l; + int o; + static int o_hgk[6] = { 1, 3, 9, 19, 35, 43 }; + int p; + static int p_hgk[6] = { 1, 5, 15, 29, 51, 67 }; +// +// Check the input. +// + for ( dim = 0; dim < dim_num; dim++ ) + { + if ( level[dim] < 0 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Negative value of LEVEL[DIM]!\n"; + std::cerr << " LEVEL[" << dim << "] = " << level[dim] << "\n"; + std::exit ( 1 ); + } + + if ( rule[dim] < 1 || 12 < rule[dim] ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Illegal value of RULE[DIM]!\n"; + std::cerr << " RULE[" << dim << "] = " << rule[dim] << "\n"; + std::exit ( 1 ); + } + + if ( growth[dim] < 0 || 6 < growth[dim] ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Illegal value of GROWTH[DIM]!\n"; + std::cerr << " GROWTH[" << dim << "] = " << growth[dim] << "\n"; + std::exit ( 1 ); + } + } +// +// Compute the order vector. +// + for ( dim = 0; dim < dim_num; dim++ ) + { +// +// CC +// Default is Moderate Exponential Growth. +// + if ( rule[dim] == 1 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + o = 2; + while ( o < 2 * level[dim] + 1 ) + { + o = 2 * ( o - 1 ) + 1; + } + } + } + else if ( growth[dim] == 5 || growth[dim] == 0 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + o = 2; + while ( o < 4 * level[dim] + 1 ) + { + o = 2 * ( o - 1 ) + 1; + } + } + } + else if ( growth[dim] == 6 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + o = webbur::i4_power ( 2, level[dim] ) + 1; + } + } + } +// +// F2 +// Default is Moderate Exponential Growth. +// + else if ( rule[dim] == 2 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + o = 1; + while ( o < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 5 || growth[dim] == 0 ) + { + o = 1; + while ( o < 4 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 6 ) + { + o = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + } +// +// GP +// Default is Moderate Exponential Growth. +// + else if ( rule[dim] == 3 ) + { + if ( growth[dim] == 1 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Growth rate 1 for rule 3 not available!\n"; + std::exit ( 1 ); + } + else if ( growth[dim] == 2 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Growth rate 2 for rule 3 not available!\n"; + std::exit ( 1 ); + } + else if ( growth[dim] == 3 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Growth rate 3 for rule 3 not available!\n"; + std::exit ( 1 ); + } + else if ( growth[dim] == 4 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + p = 5; + o = 3; + while ( p < 2 * level[dim] + 1 ) + { + p = 2 * p + 1; + o = 2 * o + 1; + } + } + } + else if ( growth[dim] == 5 || growth[dim] == 0 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + p = 5; + o = 3; + while ( p < 4 * level[dim] + 1 ) + { + p = 2 * p + 1; + o = 2 * o + 1; + } + } + } + else if ( growth[dim] == 6 ) + { + o = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + } +// +// GL +// Default is Moderate Linear Growth. +// + else if ( rule[dim] == 4 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 || growth[dim] == 0 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + o = 1; + while ( 2 * o - 1 < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 5 ) + { + o = 1; + while ( 2 * o - 1 < 4 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 6 ) + { + o = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + } +// +// GH +// Default is Moderate Linear Growth. +// + else if ( rule[dim] == 5 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 || growth[dim] == 0 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + o = 1; + while ( 2 * o - 1 < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 5 ) + { + o = 1; + while ( 2 * o - 1 < 4 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 6 ) + { + o = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + } +// +// GGH +// Default is Moderate Linear Growth. +// + else if ( rule[dim] == 6 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 || growth[dim] == 0 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + o = 1; + while ( 2 * o - 1 < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 5 ) + { + o = 1; + while ( 2 * o - 1 < 4 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 6 ) + { + o = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + } +// +// LG +// Default is Moderate Linear Growth. +// + else if ( rule[dim] == 7 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 || growth[dim] == 0 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + o = 1; + while ( 2 * o - 1 < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 5 ) + { + o = 1; + while ( 2 * o - 1 < 4 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 6 ) + { + o = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + } +// +// GLG +// Default is Moderate Linear Growth. +// + else if ( rule[dim] == 8 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 || growth[dim] == 0 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + o = 1; + while ( 2 * o - 1 < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 5 ) + { + o = 1; + while ( 2 * o - 1 < 4 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 6 ) + { + o = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + } +// +// GJ +// Default is Moderate Linear Growth. +// + else if ( rule[dim] == 9 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 || growth[dim] == 0 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + o = 1; + while ( 2 * o - 1 < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 5 ) + { + o = 1; + while ( 2 * o - 1 < 4 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 6 ) + { + o = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + } +// +// HGK +// Default is Moderate Exponential Growth. +// Exponential growth is interpreted to mean simply take successive rules. +// + else if ( rule[dim] == 10 ) + { + if ( growth[dim] == 1 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Growth rate 1 for rule 10 not available!\n"; + std::exit ( 1 ); + } + else if ( growth[dim] == 2 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Growth rate 2 for rule 10 not available!\n"; + std::exit ( 1 ); + } + else if ( growth[dim] == 3 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Growth rate 3 for rule 10 not available!\n"; + std::exit ( 1 ); + } + else if ( growth[dim] == 4 ) + { + l = 0; + p = p_hgk[l]; + o = o_hgk[l]; + while ( p < 2 * level[dim] + 1 ) + { + l = l + 1; + if ( 5 < l ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Hermite Genz-Keister maximum level exceeded.\n"; + std::exit ( 1 ); + } + p = p_hgk[l]; + o = o_hgk[l]; + } + } + else if ( growth[dim] == 5 || growth[dim] == 0 ) + { + l = 0; + p = p_hgk[l]; + o = o_hgk[l]; + while ( p < 4 * level[dim] + 1 ) + { + l = l + 1; + if ( 5 < l ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Hermite Genz-Keister maximum level exceeded.\n"; + std::exit ( 1 ); + } + p = p_hgk[l]; + o = o_hgk[l]; + } + } + else if ( growth[dim] == 6 ) + { + l = level[dim]; + l = webbur::i4_max ( l, 0 ); + if ( 5 < l ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_GROWTH_TO_ORDER - Fatal error!\n"; + std::cerr << " Hermite Genz-Keister maximum level exceeded.\n"; + std::exit ( 1 ); + } + o = o_hgk[l]; + } + } +// +// UO +// Default is Moderate Linear Growth. +// We assume the rule is of OPEN type and that it +// has a precision typical of Gauss rules. +// + else if ( rule[dim] == 11 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 || growth[dim] == 0 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + o = 1; + while ( 2 * o - 1 < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 5 ) + { + o = 1; + while ( 2 * o - 1 < 4 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + else if ( growth[dim] == 6 ) + { + o = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + } +// +// UC +// Default is Moderate Linear Growth. +// We assume the rule is of CLOSED type and that it +// has a precision typical of Clenshaw-Curtis rules. +// + else if ( rule[dim] == 12 ) + { + if ( growth[dim] == 1 ) + { + o = level[dim] + 1; + } + else if ( growth[dim] == 2 ) + { + o = 2 * ( ( level[dim] + 1 ) / 2 ) + 1; + } + else if ( growth[dim] == 3 || growth[dim] == 0 ) + { + o = 2 * level[dim] + 1; + } + else if ( growth[dim] == 4 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + o = 2; + while ( o < 2 * level[dim] + 1 ) + { + o = 2 * ( o - 1 ) + 1; + } + } + } + else if ( growth[dim] == 5 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + o = 2; + while ( o < 4 * level[dim] + 1 ) + { + o = 2 * ( o - 1 ) + 1; + } + } + } + else if ( growth[dim] == 6 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + o = webbur::i4_power ( 2, level[dim] ) + 1; + } + } + } + order[dim] = o; + } + return; +} +//****************************************************************************80 + +void level_to_order_default ( int dim_num, int level[], int rule[], + int order[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_DEFAULT: default growth. +// +// Discussion: +// +// This function uses: +// +// * exponential growth rates for fully nested quadrature rules, +// ( "CC", "F2", "GP"); +// +// * linear growth rates for other rules. +// ( "GL", "GH", "GGH", "LG", "GLG", "GJ", "GW" ). +// +// * slow exponential growth alternative for fully nested rules: +// ("CC_SE", "F2_SE", "GP_SE"). +// +// * moderate exponential growth alternative for fully nested rules: +// ("CC_ME", "F2_ME", "GP_ME"). +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int DIM_NUM, the spatial dimension. +// +// Input, int LEVEL[DIM_NUM], the 1D levels. +// +// Input, int RULE[DIM_NUM], the rule in each dimension. +// 1, "CC", Clenshaw Curtis, Closed Fully Nested rule. +// 2, "F2", Fejer Type 2, Open Fully Nested rule. +// 3, "GP", Gauss Patterson, Open Fully Nested rule. +// 4, "GL", Gauss Legendre, Open Weakly Nested rule. +// 5, "GH", Gauss Hermite, Open Weakly Nested rule. +// 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested rule. +// 7, "LG", Gauss Laguerre, Open Non Nested rule. +// 8, "GLG", Generalized Gauss Laguerre, Open Non Nested rule. +// 9, "GJ", Gauss Jacobi, Open Non Nested rule. +// 10, "GW", Golub Welsch, (presumed) Open Non Nested rule. +// 11, "CC_SE", Clenshaw Curtis Slow Exponential, Closed Fully Nested rule. +// 12, "F2_SE", Fejer Type 2 Slow Exponential, Open Fully Nested rule. +// 13, "GP_SE", Gauss Patterson Slow Exponential, Open Fully Nested rule. +// 14, "CC_ME", Clenshaw Curtis Moderate Exponential, Closed Fully Nested rule. +// 15, "F2_ME", Fejer Type 2 Moderate Exponential, Open Fully Nested rule. +// 16, "GP_ME", Gauss Patterson Moderate Exponential, Open Fully Nested rule. +// 17, "CCN", Clenshaw Curtis Nested, Linear, Closed Fully Nested rule. +// +// Output, int ORDER[DIM_NUM], the 1D orders (number of points). +// +{ + int dim; + int o; + int p; + + for ( dim = 0; dim < dim_num; dim++ ) + { + if ( level[dim] < 0 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_DEFAULT - Fatal error!\n"; + std::cerr << " Negative value of LEVEL[DIM]!\n"; + std::cerr << " LEVEL[" << dim << "] = " << level[dim] << "\n"; + std::exit ( 1 ); + } + else if ( rule[dim] == 1 ) + { + if ( level[dim] == 0 ) + { + order[dim] = 1; + } + else + { + order[dim] = webbur::i4_power ( 2, level[dim] ) + 1; + } + } + else if ( rule[dim] == 2 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 3 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 4 ) + { + order[dim] = 2 * level[dim] + 1; + } + else if ( rule[dim] == 5 ) + { + order[dim] = 2 * level[dim] + 1; + } + else if ( rule[dim] == 6 ) + { + order[dim] = 2 * level[dim] + 1; + } + else if ( rule[dim] == 7 ) + { + order[dim] = 2 * level[dim] + 1; + } + else if ( rule[dim] == 8 ) + { + order[dim] = 2 * level[dim] + 1; + } + else if ( rule[dim] == 9 ) + { + order[dim] = 2 * level[dim] + 1; + } + else if ( rule[dim] == 10 ) + { + order[dim] = 2 * level[dim] + 1; + } + else if ( rule[dim] == 11 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + o = 2; + while ( o < 2 * level[dim] + 1 ) + { + o = 2 * ( o - 1 ) + 1; + } + } + order[dim] = o; + } + else if ( rule[dim] == 12 ) + { + o = 1; + while ( o < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + order[dim] = o; + } + else if ( rule[dim] == 13 ) + { + if ( level[dim] == 0 ) + { + order[dim] = 1; + } + else + { + p = 5; + o = 3; + while ( p < 2 * level[dim] + 1 ) + { + p = 2 * p + 1; + o = 2 * o + 1; + } + order[dim] = o; + } + } + else if ( rule[dim] == 14 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + o = 2; + while ( o < 4 * level[dim] + 1 ) + { + o = 2 * ( o - 1 ) + 1; + } + } + order[dim] = o; + } + else if ( rule[dim] == 15 ) + { + o = 1; + while ( o < 4 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + order[dim] = o; + } + else if ( rule[dim] == 16 ) + { + if ( level[dim] == 0 ) + { + order[dim] = 1; + } + else + { + p = 5; + o = 3; + while ( p < 4 * level[dim] + 1 ) + { + p = 2 * p + 1; + o = 2 * o + 1; + } + order[dim] = o; + } + } + else if ( rule[dim] == 17 ) + { + order[dim] = 2 * level[dim] + 1; + } + else + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_DEFAULT - Fatal error!\n"; + std::cerr << " Unexpected value of RULE[" + << dim << "] = " << rule[dim] << ".\n"; + std::exit ( 1 ); + } + } + return; +} +//****************************************************************************80 + +void level_to_order_exponential ( int dim_num, int level[], int rule[], + int order[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_EXPONENTIAL: exponential growth. +// +// Discussion: +// +// The user must preallocate space for the output array ORDER. +// +// Closed rules: +// +// O(0) = 1 +// O(L) = 2^L + 1; +// +// O = 1, 3, 5, 9, 17, 33, ... +// +// Open rules: +// +// O(L) = 2^(L+1) - 1; +// +// O = 1, 3, 7, 15, 31, 63, ... +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int DIM_NUM, the spatial dimension. +// +// Input, int LEVEL[DIM_NUM], the 1D levels. +// +// Input, int RULE[DIM_NUM], the rule in each dimension. +// 1, "CC", Clenshaw Curtis, Closed Fully Nested rule. +// 2, "F2", Fejer Type 2, Open Fully Nested rule. +// 3, "GP", Gauss Patterson, Open Fully Nested rule. +// 4, "GL", Gauss Legendre, Open Weakly Nested rule. +// 5, "GH", Gauss Hermite, Open Weakly Nested rule. +// 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested rule. +// 7, "LG", Gauss Laguerre, Open Non Nested rule. +// 8, "GLG", Generalized Gauss Laguerre, Open Non Nested rule. +// 9, "GJ", Gauss Jacobi, Open Non Nested rule. +// 10, "GW", Golub Welsch, (presumed) Open Non Nested rule. +// 11, "CC_SE", Clenshaw Curtis Slow Exponential, Closed Fully Nested rule. +// 12, "F2_SE", Fejer Type 2 Slow Exponential, Open Fully Nested rule. +// 13, "GP_SE", Gauss Patterson Slow Exponential, Open Fully Nested rule. +// 14, "CC_ME", Clenshaw Curtis Moderate Exponential, Closed Fully Nested rule. +// 15, "F2_ME", Fejer Type 2 Moderate Exponential, Open Fully Nested rule. +// 16, "GP_ME", Gauss Patterson Moderate Exponential, Open Fully Nested rule. +// 17, "CCN", Clenshaw Curtis Nested, Linear, Closed Fully Nested rule. +// +// Output, int ORDER[DIM_NUM], the 1D orders (number of points). +// +{ + int dim; + + for ( dim = 0; dim < dim_num; dim++ ) + { + if ( level[dim] < 0 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXPONENTIAL - Fatal error!\n"; + std::cerr << " Negative value of LEVEL[DIM]!\n"; + std::cerr << " LEVEL[" << dim << "] = " << level[dim] << "\n"; + std::exit ( 1 ); + } + else if ( rule[dim] == 1 ) + { + if ( level[dim] == 0 ) + { + order[dim] = 1; + } + else + { + order[dim] = webbur::i4_power ( 2, level[dim] ) + 1; + } + } + else if ( rule[dim] == 2 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 3 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 4 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 5 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 6 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 7 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 8 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 9 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 10 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 11 ) + { + if ( level[dim] == 0 ) + { + order[dim] = 1; + } + else + { + order[dim] = webbur::i4_power ( 2, level[dim] ) + 1; + } + } + else if ( rule[dim] == 12 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 13 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 14 ) + { + if ( level[dim] == 0 ) + { + order[dim] = 1; + } + else + { + order[dim] = webbur::i4_power ( 2, level[dim] ) + 1; + } + } + else if ( rule[dim] == 15 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 16 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ) - 1; + } + else if ( rule[dim] == 17 ) + { + order[dim] = webbur::i4_power ( 2, level[dim] + 1 ); + } + else + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXPONENTIAL - Fatal error!\n"; + std::cerr << " Unexpected value of RULE[" + << dim << "] = " << rule[dim] << ".\n"; + std::exit ( 1 ); + } + } + return; +} +//****************************************************************************80 + +void level_to_order_exponential_slow ( int dim_num, int level[], int rule[], + int order[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_EXPONENTIAL_SLOW: slow exponential growth; +// +// Discussion: +// +// We seek a sequence of quadrature rules with two opposing constraints: +// * a measured rise in polynomial precision with increasing level; +// * a control on the increase in (new) points per level; +// +// Essentially, we are trying to keep some of the advantages of nesting, +// while moderating the cost of the explosive growth in order that occurs +// due to the repeated order doubling of nesting. +// +// We wish the number of points at a given level L to be "about" 2 * L + 1, +// but we also wish the rules to be completely nested. +// +// One way to do this is to start with a nested family of rules, whose +// order will tend to grow exponentially (doubling from one to the next), +// but simply to REPEAT each rule as many times as possible. We move to +// the next rule only when the desired precision 2 * L + 1 exceeds the +// precision of the current rule. +// +// For both the Clenshaw Curtis and Fejer Type 2 rules, the order and +// precision are the same if the order is odd. That is, an 11 point rule +// will integrate exactly all polynomials up to and including degree 11. +// +// For Gauss Patterson rules, the relationship between order and precision +// is somewhat more complicated. For that rule, we take the philosophy +// that at each level L, we wish to choose the rule of smallest order +// so that the precision of 2 * L + 1 is guaranteed. +// +// L 2*L+1 CC Order F2 Order GP Order/Precision +// +// 0 1 1 1 1/1 +// 1 3 3 3 3/5 +// 2 5 5 7 3/5 +// 3 7 9 7 7/11 +// 4 9 9 15 7/11 +// 5 11 17 15 7/11 +// 6 13 17 15 15/23 +// 7 15 17 15 15/23 +// 8 17 17 31 15/23 +// 9 19 33 31 15/23 +// 10 21 33 31 15/23 +// 11 23 33 31 15/23 +// 12 25 33 31 31/47 +// 13 27 33 31 31/47 +// 14 29 33 31 31/47 +// 15 31 33 31 31/47 +// 16 33 33 63 31/47 +// 17 35 65 63 31/47 +// 18 37 65 63 31/47 +// 19 39 65 63 31/47 +// 20 41 65 63 31/47 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Knut Petras, +// Smolyak Cubature of Given Polynomial Degree with Few Nodes +// for Increasing Dimension, +// Numerische Mathematik, +// Volume 93, Number 4, February 2003, pages 729-753. +// +// Parameters: +// +// Input, int DIM_NUM, the spatial dimension. +// +// Input, int LEVEL[DIM_NUM], the 1D levels. +// +// Input, int RULE[DIM_NUM], the rule in each dimension. +// 1, "CC", Clenshaw Curtis, Closed Fully Nested rule. +// 2, "F2", Fejer Type 2, Open Fully Nested rule. +// 3, "GP", Gauss Patterson, Open Fully Nested rule. +// 4, "GL", Gauss Legendre, Open Weakly Nested rule. +// 5, "GH", Gauss Hermite, Open Weakly Nested rule. +// 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested rule. +// 7, "LG", Gauss Laguerre, Open Non Nested rule. +// 8, "GLG", Generalized Gauss Laguerre, Open Non Nested rule. +// 9, "GJ", Gauss Jacobi, Open Non Nested rule. +// 10, "GW", Golub Welsch, (presumed) Open Non Nested rule. +// 11, "CC_SE", Clenshaw Curtis Slow Exponential, Closed Fully Nested rule. +// 12, "F2_SE", Fejer Type 2 Slow Exponential, Open Fully Nested rule. +// 13, "GP_SE", Gauss Patterson Slow Exponential, Open Fully Nested rule. +// 14, "CC_ME", Clenshaw Curtis Moderate Exponential, Closed Fully Nested rule. +// 15, "F2_ME", Fejer Type 2 Moderate Exponential, Open Fully Nested rule. +// 16, "GP_ME", Gauss Patterson Moderate Exponential, Open Fully Nested rule. +// 17, "CCN", Clenshaw Curtis Nested, Linear, Closed Fully Nested rule. +// +// Output, int ORDER[DIM_NUM], the 1D orders (number of points). +// +{ + int dim; + int o; + int p; + + for ( dim = 0; dim < dim_num; dim++ ) + { + if ( level[dim] < 0 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXPONENTIAL_SLOW - Fatal error!\n"; + std::cerr << " Negative value of LEVEL[DIM]!\n"; + std::cerr << " LEVEL[" << dim << "] = " << level[dim] << "\n"; + std::exit ( 1 ); + } + } + + for ( dim = 0; dim < dim_num; dim++ ) + { + if ( rule[dim] == 1 || rule[dim] == 11 || rule[dim] == 14 || rule[dim] == 17 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + o = 2; + while ( o < 2 * level[dim] + 1 ) + { + o = 2 * ( o - 1 ) + 1; + } + } + } + else if ( rule[dim] == 3 || rule[dim] == 13 || rule[dim] == 16 ) + { + if ( level[dim] == 0 ) + { + o = 1; + } + else + { + p = 5; + o = 3; + while ( p < 2 * level[dim] + 1 ) + { + p = 2 * p + 1; + o = 2 * o + 1; + } + } + } + else + { + o = 1; + while ( o < 2 * level[dim] + 1 ) + { + o = 2 * o + 1; + } + } + order[dim] = o; + } + + return; +} +//****************************************************************************80 + +void level_to_order_linear ( int dim_num, int level[], int rule[], + int order[] ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_LINEAR: linear growth. +// +// Discussion: +// +// The user must preallocate space for the output array ORDER. +// +// O(L) = 2 * L + 1; +// +// O = 1, 3, 5, 7, 9, ... +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 07 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int DIM_NUM, the spatial dimension. +// +// Input, int LEVEL[DIM_NUM], the 1D levels. +// +// Input, int RULE[DIM_NUM], the rule in each dimension. +// 1, "CC", Clenshaw Curtis, Closed Fully Nested rule. +// 2, "F2", Fejer Type 2, Open Fully Nested rule. +// 3, "GP", Gauss Patterson, Open Fully Nested rule. +// 4, "GL", Gauss Legendre, Open Weakly Nested rule. +// 5, "GH", Gauss Hermite, Open Weakly Nested rule. +// 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested rule. +// 7, "LG", Gauss Laguerre, Open Non Nested rule. +// 8, "GLG", Generalized Gauss Laguerre, Open Non Nested rule. +// 9, "GJ", Gauss Jacobi, Open Non Nested rule. +// 10, "GW", Golub Welsch, (presumed) Open Non Nested rule. +// 11, "CC_SE", Clenshaw Curtis Slow Exponential, Closed Fully Nested rule. +// 12, "F2_SE", Fejer Type 2 Slow Exponential, Open Fully Nested rule. +// 13, "GP_SE", Gauss Patterson Slow Exponential, Open Fully Nested rule. +// 14, "CC_ME", Clenshaw Curtis Moderate Exponential, Closed Fully Nested rule. +// 15, "F2_ME", Fejer Type 2 Moderate Exponential, Open Fully Nested rule. +// 16, "GP_ME", Gauss Patterson Moderate Exponential, Open Fully Nested rule. +// 17, "CCN", Clenshaw Curtis Nested, Linear, Closed Fully Nested rule. +// +// Output, int ORDER[DIM_NUM], the 1D orders (number of points). +// +{ + int dim; + + for ( dim = 0; dim < dim_num; dim++ ) + { + if ( level[dim] < 0 ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_LINEAR - Fatal error!\n"; + std::cerr << " Negative value of LEVEL[DIM]!\n"; + std::cerr << " LEVEL[" << dim << "] = " << level[dim] << "\n"; + std::exit ( 1 ); + } + } + + for ( dim = 0; dim < dim_num; dim++ ) + { + order[dim] = 2 * level[dim] + 1; + } + + return; +} +//****************************************************************************80 + +int level_to_order_exp_cc ( int level, int growth ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_EXP_CC is used for Clenshaw-Curtis type rules. +// +// Discussion: +// +// Rules of this type are assumed to be closed (including both endpoints +// except for the level 0 rule) and having a precision +// behavior typical of Clenshaw Curtis rules, namely, the ORDER-point +// rule is exact for polynomials of degree less than ORDER, and if +// ORDER is odd, then the exactness includes polynomials of degree ORDER +// as well. +// +// LEVEL ORDER ORDER ORDER +// G = 0 G = 1 G = 2 +// ----- ----- ----- ----- +// 0 1 1 1 +// 1 3 5 3 +// 2 5 9 5 +// 3 9 17 9 +// 4 9 17 17 +// 5 17 33 33 +// 6 17 33 65 +// 7 17 33 129 +// 8 17 33 257 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 December 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int LEVEL, the level of the rule. +// +// Input, int GROWTH, the growth policy: +// 0, slow growth; +// 1, moderate growth; +// 2, full growth. +// +// Output, int LEVEL_TO_ORDER_EXP_CC, the order of the rule. +// +{ + int o; +// +// Slow exponential growth. +// + if ( growth == 0 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = 2; + while ( o < 2 * level + 1 ) + { + o = 2 * ( o - 1 ) + 1; + } + } + } +// +// Moderate Exponential Growth. +// + else if ( growth == 1 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = 2; + while ( o < 4 * level + 1 ) + { + o = 2 * ( o - 1 ) + 1; + } + } + } +// +// Full Exponential Growth. +// + else if ( growth == 2 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = webbur::i4_power ( 2, level ) + 1; + } + } + else + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_CC - Fatal error!\n"; + std::cerr << " Illegal value of GROWTH = " << growth << "\n"; + std::exit ( 1 ); + } + return o; +} +//****************************************************************************80 + +int level_to_order_exp_f2 ( int level, int growth ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_EXP_F2 is used for Fejer 2 type rules. +// +// Discussion: +// +// Rules of this type are assumed to be open (not including either endpoint) +// and having a precision behavior typical of Fejer Type 2 +// rules, namely, the ORDER-point rule is exact for polynomials of degree +// less than ORDER, and if ORDER is odd, then the exactness includes +// polynomials of degree ORDER as well. +// +// LEVEL ORDER ORDER ORDER +// G = 0 G = 1 G = 2 +// +// 0 1 1 1 +// 1 3 7 3 +// 2 7 15 7 +// 3 7 15 15 +// 4 15 31 31 +// 5 15 31 63 +// 6 15 31 127 +// 7 15 31 255 +// 8 31 63 511 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 December 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int LEVEL, the level of the rule. +// +// Input, int GROWTH, the growth policy: +// 0, slow growth; +// 1, moderate growth; +// 2, full growth. +// +// Output, int LEVEL_TO_ORDER_EXP_F2, the order of the rule. +// +{ + int o; +// +// Slow exponential growth. +// + if ( growth == 0 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = 1; + while ( o < 2 * level + 1 ) + { + o = 2 * o + 1; + } + } + } +// +// Moderate Exponential Growth. +// + else if ( growth == 1 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = 1; + while ( o < 4 * level + 1 ) + { + o = 2 * o + 1; + } + } + } +// +// Full Exponential Growth. +// + else if ( growth == 2 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = webbur::i4_power ( 2, level + 1 ) - 1; + } + } + else + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_F2 - Fatal error!\n"; + std::cerr << " Illegal value of GROWTH = " << growth << "\n"; + std::exit ( 1 ); + } + return o; +} +//****************************************************************************80 + +int level_to_order_exp_gauss ( int level, int growth ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_EXP_GAUSS is used for Gauss type rules. +// +// Discussion: +// +// Rules of this type are assumed to be open (not including either endpoint), +// and having a precision behavior typical of Gauss rules, namely, the +// ORDER-point rule is exact for polynomials of degree less than 2 * ORDER. +// +// LEVEL ORDER ORDER ORDER +// G = 0 G = 1 G = 2 +// +// 0 1 1 1 +// 1 3 3 3 +// 2 3 7 7 +// 3 7 7 15 +// 4 7 15 31 +// 5 7 15 63 +// 6 7 15 127 +// 7 15 15 255 +// 8 15 31 511 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 December 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int LEVEL, the level of the rule. +// +// Input, int GROWTH, the growth policy: +// 0, slow growth; +// 1, moderate growth; +// 2, full growth. +// +// Output, int LEVEL_TO_ORDER_EXP_GAUSS, the order of the rule. +// +{ + int o; +// +// Slow exponential growth. +// + if ( growth == 0 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = 1; + while ( 2 * o - 1 < 2 * level + 1 ) + { + o = 2 * o + 1; + } + } + } +// +// Moderate Exponential Growth. +// + else if ( growth == 1 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = 1; + while ( 2 * o - 1 < 4 * level + 1 ) + { + o = 2 * o + 1; + } + } + } +// +// Full Exponential Growth. +// + else if ( growth == 2 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = webbur::i4_power ( 2, level + 1 ) - 1; + } + } + else + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_GAUSS - Fatal error!\n"; + std::cerr << " Illegal value of GROWTH = " << growth << "\n"; + std::exit ( 1 ); + } + + return o; +} +//****************************************************************************80 + +int level_to_order_exp_gp ( int level, int growth ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_EXP_GP is used for Gauss-Patterson type rules. +// +// Discussion: +// +// Rules of this type are assumed to be open (not including either endpoint) +// and having a precision behavior typical of Gauss Patterson rules. +// +// Note that there are onlly 9 rules in the family, and so it is possible to +// specify input for which the function will fail. +// +// LEVEL ORDER ORDER ORDER +// G = 0 G = 1 G = 2 +// +// 0 1 1 1 +// 1 3 3 3 +// 2 3 7 7 +// 3 7 15 15 +// 4 7 15 31 +// 5 7 15 63 +// 6 15 31 127 +// 7 15 31 255 +// 8 15 31 511 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 December 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int LEVEL, the level of the rule. +// +// Input, int GROWTH, the growth policy: +// 0, slow growth; +// 1, moderate growth; +// 2, full growth. +// +// Output, int LEVEL_TO_ORDER_EXP_GP, the order of the rule. +// +{ + int o; + int p; +// +// Slow exponential growth. +// + if ( growth == 0 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + p = 5; + o = 3; + while ( p < 2 * level + 1 ) + { + p = 2 * p + 1; + o = 2 * o + 1; + if ( 511 < o ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_GP - Fatal error!\n"; + std::cerr << " Request for unavailable Patterson rule.\n"; + std::exit ( 1 ); + } + } + } + } +// +// Moderate Exponential Growth. +// + else if ( growth == 1 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + p = 5; + o = 3; + while ( p < 4 * level + 1 ) + { + p = 2 * p + 1; + o = 2 * o + 1; + if ( 511 < o ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_GP - Fatal error!\n"; + std::cerr << " Request for unavailable Patterson rule.\n"; + std::exit ( 1 ); + } + } + } + } +// +// Full Exponential Growth. +// + else if ( growth == 2 ) + { + if ( level == 0 ) + { + o = 1; + } + else + { + o = webbur::i4_power ( 2, level + 1 ) - 1; + if ( 511 < o ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_GP - Fatal error!\n"; + std::cerr << " Request for unavailable Patterson rule.\n"; + std::exit ( 1 ); + } + } + } + else + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_GP - Fatal error!\n"; + std::cerr << " Illegal value of GROWTH = " << growth << "\n"; + std::exit ( 1 ); + } + + return o; +} +//****************************************************************************80 + +int level_to_order_exp_hgk ( int level, int growth ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_EXP_HGK is used for Hermite Genz-Keister type rules. +// +// Discussion: +// +// Rules of this type are assumed to be open (not including either endpoint) +// and having a precision behavior typical of Hermite Genz-Keister rules. +// +// Note that there are only 6 rules in the family, and so it is possible to +// specify input for which the function will fail. +// +// LEVEL ORDER ORDER ORDER +// G = 0 G = 1 G = 2 +// +// 0 1 1 1 +// 1 3 3 3 +// 2 3 9 9 +// 3 9 9 19 +// 4 9 19 35 +// 5 9 19 43 +// 6 9 19 -- +// 7 9 19 -- +// 8 19 35 -- +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 December 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int LEVEL, the level of the rule. +// +// Input, int GROWTH, the growth policy: +// 0, slow growth; +// 1, moderate growth; +// 2, full growth. +// +// Output, int LEVEL_TO_ORDER_EXP_HGK, the order of the rule. +// +{ + int l; + int o; + static int o_hgk[6] = { 1, 3, 9, 19, 35, 43 }; + int p; + static int p_hgk[6] = { 1, 5, 15, 29, 51, 67 }; +// +// Slow exponential growth. +// + if ( growth == 0 ) + { + l = 0; + p = p_hgk[l]; + o = o_hgk[l]; + while ( p < 2 * level + 1 ) + { + l = l + 1; + if ( 5 < l ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_HGK - Fatal error!\n"; + std::cerr << " Hermite Genz-Keister maximum level exceeded.\n"; + std::exit ( 1 ); + } + p = p_hgk[l]; + o = o_hgk[l]; + } + } + else if ( growth == 1 ) + { + l = 0; + p = p_hgk[l]; + o = o_hgk[l]; + while ( p < 4 * level + 1 ) + { + l = l + 1; + if ( 5 < l ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_HGK - Fatal error!\n"; + std::cerr << " Hermite Genz-Keister maximum level exceeded.\n"; + std::exit ( 1 ); + } + p = p_hgk[l]; + o = o_hgk[l]; + } + } + else if ( growth == 2 ) + { + l = level; + l = webbur::i4_max ( l, 0 ); + if ( 5 < l ) + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_HGK - Fatal error!\n"; + std::cerr << " Hermite Genz-Keister maximum level exceeded.\n"; + std::exit ( 1 ); + } + o = o_hgk[l]; + } + else + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_EXP_HGK - Fatal error!\n"; + std::cerr << " Illegal value of GROWTH = " << growth << "\n"; + std::exit ( 1 ); + } + + return o; +} +//****************************************************************************80 + +int level_to_order_linear_nn ( int level, int growth ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_LINEAR_NN is used for non-nested Gauss type rules. +// +// Discussion: +// +// Rules of this type are assumed to be open (not including either endpoint), +// non-nested, and having a precision behavior typical of Gauss rules. +// +// LEVEL ORDER ORDER +// G = 0 G = 1 +// +// 0 1 1 +// 1 2 3 +// 2 3 5 +// 3 4 7 +// 4 5 9 +// 5 6 11 +// 6 7 13 +// 7 8 15 +// 8 9 17 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 December 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int LEVEL, the level of the rule. +// +// Input, int GROWTH, the growth policy: +// 0, slow growth; +// 1, moderate growth; +// +// Output, int LEVEL_TO_ORDER_LINEAR_NN, the order of the rule. +// +{ + int o; +// +// Slow linear growth. +// + if ( growth == 0 ) + { + o = level + 1; + } +// +// Moderate linear growth. +// + else if ( growth == 1 ) + { + o = 2 * level + 1; + } + else if ( growth == 2 ) + { + o = 2 * level + 1; + } + else + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_LINEAR_NN - Fatal error!\n"; + std::cerr << " Illegal value of GROWTH = " << growth << "\n"; + std::exit ( 1 ); + } + return o; +} +//****************************************************************************80 + +int level_to_order_linear_wn ( int level, int growth ) + +//****************************************************************************80 +// +// Purpose: +// +// LEVEL_TO_ORDER_LINEAR_WN is used for weakly-nested Gauss type rules. +// +// Discussion: +// +// Rules of this type are assumed to be open (not including either endpoint), +// nested, and having a precision behavior typical of Gauss rules. +// +// We assume the rules are to be generated with an odd number of points, +// and that all the rules will share a single point, namely 0. +// +// Note that the "moderate growth" option for this function results in the +// same values as the moderate growth option for LEVEL_TO_ORDER_LINEAR_NN. +// +// LEVEL ORDER ORDER +// G = 0 G = 1 +// +// 0 1 1 +// 1 3 3 +// 2 3 5 +// 3 5 7 +// 4 5 9 +// 5 7 11 +// 6 7 13 +// 7 9 15 +// 8 9 17 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 December 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int LEVEL, the level of the rule. +// +// Input, int GROWTH, the growth policy: +// 0, slow growth; +// 1, moderate growth; +// +// Output, int LEVEL_TO_ORDER_LINEAR_WN, the order of the rule. +// +{ + int o; +// +// Slow growth. +// + if ( growth == 0 ) + { + o = 2 * ( ( level + 1 ) / 2 ) + 1; + } + else if ( growth == 1 ) + { + o = 2 * level + 1; + } + else if ( growth == 2 ) + { + o = 2 * level + 1; + } + else + { + std::cerr << "\n"; + std::cerr << "LEVEL_TO_ORDER_LINEAR_WN - Fatal error!\n"; + std::cerr << " Illegal value of GROWTH = " << growth << "\n"; + std::exit ( 1 ); + } + return o; +} +//****************************************************************************80 + +void nc_compute ( int n, double x_min, double x_max, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// NC_COMPUTE computes a Newton-Cotes quadrature rule. +// +// Discussion: +// +// For the interval [X_MIN,X_MAX], the Newton-Cotes quadrature rule +// estimates +// +// Integral ( X_MIN <= X <= X_MAX ) F(X) dX +// +// using N abscissas X and weights W: +// +// Sum ( 1 <= I <= N ) W(I) * F ( X(I) ). +// +// For the CLOSED rule, the abscissas include the end points. +// For the OPEN rule, the abscissas do not include the end points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 November 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, double X_MIN, X_MAX, the endpoints of the interval. +// +// Input, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + double *d; + int i; + int j; + int k; + double yvala; + double yvalb; + + d = new double[n]; + + for ( i = 0; i < n; i++ ) + { +// +// Compute the Lagrange basis polynomial which is 1 at XTAB(I), +// and zero at the other nodes. +// + for ( j = 0; j < n; j++ ) + { + d[j] = 0.0; + } + d[i] = 1.0; + + for ( j = 2; j <= n; j++ ) + { + for ( k = j; k <= n; k++ ) + { + d[n+j-k-1] = ( d[n+j-k-1-1] - d[n+j-k-1] ) / ( x[n+1-k-1] - x[n+j-k-1] ); + } + } + + for ( j = 1; j <= n - 1; j++ ) + { + for ( k = 1; k <= n - j; k++ ) + { + d[n-k-1] = d[n-k-1] - x[n-k-j] * d[n-k]; + } + } +// +// Evaluate the antiderivative of the polynomial at the left and +// right endpoints. +// + yvala = d[n-1] / ( double ) ( n ); + for ( j = n - 2; 0 <= j; j-- ) + { + yvala = yvala * x_min + d[j] / ( double ) ( j + 1 ); + } + yvala = yvala * x_min; + + yvalb = d[n-1] / ( double ) ( n ); + for ( j = n - 2; 0 <= j; j-- ) + { + yvalb = yvalb * x_max + d[j] / ( double ) ( j + 1 ); + } + yvalb = yvalb * x_max; + + w[i] = yvalb - yvala; + } + + delete [] d; + + return; +} +//****************************************************************************80 + +double *nc_compute_new ( int n, double x_min, double x_max, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// NC_COMPUTE_NEW computes a Newton-Cotes quadrature rule. +// +// Discussion: +// +// For the interval [X_MIN,X_MAX], the Newton-Cotes quadrature rule +// estimates +// +// Integral ( X_MIN <= X <= X_MAX ) F(X) dX +// +// using N abscissas X and weights W: +// +// Sum ( 1 <= I <= N ) W(I) * F ( X(I) ). +// +// For the CLOSED rule, the abscissas include the end points. +// For the OPEN rule, the abscissas do not include the end points. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 November 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Input, double X_MIN, X_MAX, the endpoints of the interval. +// +// Input, double X[N], the abscissas. +// +// Output, double NC_COMPUTE_NEW[N], the weights. +// +{ + double *d; + int i; + int j; + int k; + double *w; + double yvala; + double yvalb; + + d = new double[n]; + w = new double[n]; + + for ( i = 0; i < n; i++ ) + { +// +// Compute the Lagrange basis polynomial which is 1 at XTAB(I), +// and zero at the other nodes. +// + for ( j = 0; j < n; j++ ) + { + d[j] = 0.0; + } + d[i] = 1.0; + + for ( j = 2; j <= n; j++ ) + { + for ( k = j; k <= n; k++ ) + { + d[n+j-k-1] = ( d[n+j-k-1-1] - d[n+j-k-1] ) / ( x[n+1-k-1] - x[n+j-k-1] ); + } + } + + for ( j = 1; j <= n - 1; j++ ) + { + for ( k = 1; k <= n - j; k++ ) + { + d[n-k-1] = d[n-k-1] - x[n-k-j] * d[n-k]; + } + } +// +// Evaluate the antiderivative of the polynomial at the left and +// right endpoints. +// + yvala = d[n-1] / ( double ) ( n ); + for ( j = n - 2; 0 <= j; j-- ) + { + yvala = yvala * x_min + d[j] / ( double ) ( j + 1 ); + } + yvala = yvala * x_min; + + yvalb = d[n-1] / ( double ) ( n ); + for ( j = n - 2; 0 <= j; j-- ) + { + yvalb = yvalb * x_max + d[j] / ( double ) ( j + 1 ); + } + yvalb = yvalb * x_max; + + w[i] = yvalb - yvala; + } + + delete [] d; + + return w; +} +//****************************************************************************80 + +void ncc_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// NCC_COMPUTE_POINTS: points of a Newton-Cotes Closed quadrature rule. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 16 November 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double X[N], the abscissas. +// +{ + int i; + double x_max = 1.0; + double x_min = -1.0; + + if ( n == 1 ) + { + x[0] = ( x_max + x_min ) / 2.0; + } + else + { + for ( i = 0; i < n; i++ ) + { + x[i] = ( ( double ) ( n - i - 1 ) * x_min + + ( double ) ( i ) * x_max ) + / ( double ) ( n - 1 ); + } + } + return; +} +//****************************************************************************80 + +void ncc_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// NCC_COMPUTE_WEIGHTS: weights of a Newton-Cotes Closed quadrature rule. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 16 November 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double W[N], the weights. +// +{ + int i; + double *x; + double x_max = 1.0; + double x_min = -1.0; + + if ( n == 1 ) + { + w[0] = x_max - x_min; + } + else + { + x = new double[n]; + + for ( i = 0; i < n; i++ ) + { + x[i] = ( ( double ) ( n - i - 1 ) * x_min + + ( double ) ( i ) * x_max ) + / ( double ) ( n - 1 ); + } + webbur::nc_compute ( n, x_min, x_max, x, w ); + + delete [] x; + } + return; +} +//****************************************************************************80 + +void nco_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// NCO_COMPUTE_POINTS: points for a Newton-Cotes Open quadrature rule. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 November 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double X[N], the abscissas. +// +{ + int i; + double x_max = 1.0; + double x_min = -1.0; + + for ( i = 0; i < n; i++ ) + { + x[i] = ( ( double ) ( n - i ) * x_min + + ( double ) ( + i + 1 ) * x_max ) + / ( double ) ( n + 1 ); + } + + return; +} +//****************************************************************************80 + +void nco_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// NCO_COMPUTE_WEIGHTS: weights for a Newton-Cotes Open quadrature rule. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 November 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double W[N], the weights. +// +{ + int i; + double *x; + double x_max = 1.0; + double x_min = -1.0; + + x = new double[n]; + + webbur::nco_compute_points ( n, x ); + + webbur::nc_compute ( n, x_min, x_max, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void ncoh_compute_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// NCOH_COMPUTE_POINTS computes points for a Newton-Cotes "open half" quadrature rule. +// +// Discussion: +// +// The input value N is used to define N equal subintervals of [-1,+1]. +// The I-th abscissa is the center of the I-th subinterval. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 03 July 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double X[N], the abscissas. +// +{ + int i; + const double x_max = 1.0; + const double x_min = -1.0; + + for ( i = 0; i < n; i++ ) + { + x[i] = ( ( double ) ( 2 * n - 2 * i - 1 ) * x_min + + ( double ) ( 2 * i + 1 ) * x_max ) + / ( double ) ( 2 * n ); + } + + return; +} +//****************************************************************************80 + +void ncoh_compute_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// NCOH_COMPUTE_WEIGHTS computes weights for a Newton-Cotes "open half" quadrature rule. +// +// Discussion: +// +// The input value N is used to define N equal subintervals of [-1,+1]. +// The I-th abscissa is the center of the I-th subinterval. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 03 July 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order. +// +// Output, double W[N], the weights. +// +{ + int i; + double *x; + const double x_max = 1.0; + const double x_min = -1.0; + + x = new double[n]; + + webbur::ncoh_compute_points ( n, x ); + + webbur::nc_compute ( n, x_min, x_max, x, w ); + + delete [] x; + + return; +} +//****************************************************************************80 + +void patterson_lookup ( int n, double x[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// PATTERSON_LOOKUP looks up Patterson quadrature points and weights. +// +// Discussion: +// +// Our convention is that the abscissas are numbered from left to right. +// +// The rule is defined on [-1,1], +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 11 February 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Prem Kythe, Michael Schaeferkotter, +// Handbook of Computational Methods for Integration, +// Chapman and Hall, 2004, +// ISBN: 1-58488-428-2, +// LC: QA299.3.K98. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// Legal values are 1, 3, 7, 15, 31, 63, 127, 255 and 511. +// +// Output, double X[N], the abscissas. +// +// Output, double W[N], the weights. +// +{ + patterson_lookup_points ( n, x ); + patterson_lookup_weights ( n, w ); + + return; +} +//****************************************************************************80 + +void patterson_lookup_points ( int n, double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// PATTERSON_LOOKUP_POINTS looks up Patterson quadrature points. +// +// Discussion: +// +// Our convention is that the abscissas are numbered from left to right. +// +// The rule is defined on [-1,1], +// +// These rules constitute a nested family. The rules can integrate exactly +// any polynomial of degree 1, 5, 11, 23, 47, 95, 191, 383 or 767, +// respectively. +// +// The data for N = 511 was supplied by Dirk Laurie, and is derived +// from a NAG Library function d01arf. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 14 September 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Prem Kythe, Michael Schaeferkotter, +// Handbook of Computational Methods for Integration, +// Chapman and Hall, 2004, +// ISBN: 1-58488-428-2, +// LC: QA299.3.K98. +// +// NAG Library Documentation, +// D01ARF, +// The Numerical Algorithms Group. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// Legal values are 1, 3, 7, 15, 31, 63, 127, 255 and 511. +// +// Output, double X[N], the abscissas. +// +{ + static double x_001[1] = + { + 0.0 + }; + static double x_003[3] = + { + -0.77459666924148337704, + 0.0, + 0.77459666924148337704 + }; + static double x_007[7] = + { + -0.96049126870802028342, + -0.77459666924148337704, + -0.43424374934680255800, + 0.0, + 0.43424374934680255800, + 0.77459666924148337704, + 0.96049126870802028342 + }; + static double x_015[15] = + { + -0.99383196321275502221, + -0.96049126870802028342, + -0.88845923287225699889, + -0.77459666924148337704, + -0.62110294673722640294, + -0.43424374934680255800, + -0.22338668642896688163, + 0.0, + 0.22338668642896688163, + 0.43424374934680255800, + 0.62110294673722640294, + 0.77459666924148337704, + 0.88845923287225699889, + 0.96049126870802028342, + 0.99383196321275502221 + }; + static double x_031[31] = + { + -0.99909812496766759766, + -0.99383196321275502221, + -0.98153114955374010687, + -0.96049126870802028342, + -0.92965485742974005667, + -0.88845923287225699889, + -0.83672593816886873550, + -0.77459666924148337704, + -0.70249620649152707861, + -0.62110294673722640294, + -0.53131974364437562397, + -0.43424374934680255800, + -0.33113539325797683309, + -0.22338668642896688163, + -0.11248894313318662575, + 0.0, + 0.11248894313318662575, + 0.22338668642896688163, + 0.33113539325797683309, + 0.43424374934680255800, + 0.53131974364437562397, + 0.62110294673722640294, + 0.70249620649152707861, + 0.77459666924148337704, + 0.83672593816886873550, + 0.88845923287225699889, + 0.92965485742974005667, + 0.96049126870802028342, + 0.98153114955374010687, + 0.99383196321275502221, + 0.99909812496766759766 + }; + static double x_063[63] = + { + -0.99987288812035761194, + -0.99909812496766759766, + -0.99720625937222195908, + -0.99383196321275502221, + -0.98868475754742947994, + -0.98153114955374010687, + -0.97218287474858179658, + -0.96049126870802028342, + -0.94634285837340290515, + -0.92965485742974005667, + -0.91037115695700429250, + -0.88845923287225699889, + -0.86390793819369047715, + -0.83672593816886873550, + -0.80694053195021761186, + -0.77459666924148337704, + -0.73975604435269475868, + -0.70249620649152707861, + -0.66290966002478059546, + -0.62110294673722640294, + -0.57719571005204581484, + -0.53131974364437562397, + -0.48361802694584102756, + -0.43424374934680255800, + -0.38335932419873034692, + -0.33113539325797683309, + -0.27774982202182431507, + -0.22338668642896688163, + -0.16823525155220746498, + -0.11248894313318662575, + -0.056344313046592789972, + 0.0, + 0.056344313046592789972, + 0.11248894313318662575, + 0.16823525155220746498, + 0.22338668642896688163, + 0.27774982202182431507, + 0.33113539325797683309, + 0.38335932419873034692, + 0.43424374934680255800, + 0.48361802694584102756, + 0.53131974364437562397, + 0.57719571005204581484, + 0.62110294673722640294, + 0.66290966002478059546, + 0.70249620649152707861, + 0.73975604435269475868, + 0.77459666924148337704, + 0.80694053195021761186, + 0.83672593816886873550, + 0.86390793819369047715, + 0.88845923287225699889, + 0.91037115695700429250, + 0.92965485742974005667, + 0.94634285837340290515, + 0.96049126870802028342, + 0.97218287474858179658, + 0.98153114955374010687, + 0.98868475754742947994, + 0.99383196321275502221, + 0.99720625937222195908, + 0.99909812496766759766, + 0.99987288812035761194 + }; + static double x_127[127] = + { + -0.99998243035489159858, + -0.99987288812035761194, + -0.99959879967191068325, + -0.99909812496766759766, + -0.99831663531840739253, + -0.99720625937222195908, + -0.99572410469840718851, + -0.99383196321275502221, + -0.99149572117810613240, + -0.98868475754742947994, + -0.98537149959852037111, + -0.98153114955374010687, + -0.97714151463970571416, + -0.97218287474858179658, + -0.96663785155841656709, + -0.96049126870802028342, + -0.95373000642576113641, + -0.94634285837340290515, + -0.93832039777959288365, + -0.92965485742974005667, + -0.92034002547001242073, + -0.91037115695700429250, + -0.89974489977694003664, + -0.88845923287225699889, + -0.87651341448470526974, + -0.86390793819369047715, + -0.85064449476835027976, + -0.83672593816886873550, + -0.82215625436498040737, + -0.80694053195021761186, + -0.79108493379984836143, + -0.77459666924148337704, + -0.75748396638051363793, + -0.73975604435269475868, + -0.72142308537009891548, + -0.70249620649152707861, + -0.68298743109107922809, + -0.66290966002478059546, + -0.64227664250975951377, + -0.62110294673722640294, + -0.59940393024224289297, + -0.57719571005204581484, + -0.55449513263193254887, + -0.53131974364437562397, + -0.50768775753371660215, + -0.48361802694584102756, + -0.45913001198983233287, + -0.43424374934680255800, + -0.40897982122988867241, + -0.38335932419873034692, + -0.35740383783153215238, + -0.33113539325797683309, + -0.30457644155671404334, + -0.27774982202182431507, + -0.25067873030348317661, + -0.22338668642896688163, + -0.19589750271110015392, + -0.16823525155220746498, + -0.14042423315256017459, + -0.11248894313318662575, + -0.084454040083710883710, + -0.056344313046592789972, + -0.028184648949745694339, + 0.0, + 0.028184648949745694339, + 0.056344313046592789972, + 0.084454040083710883710, + 0.11248894313318662575, + 0.14042423315256017459, + 0.16823525155220746498, + 0.19589750271110015392, + 0.22338668642896688163, + 0.25067873030348317661, + 0.27774982202182431507, + 0.30457644155671404334, + 0.33113539325797683309, + 0.35740383783153215238, + 0.38335932419873034692, + 0.40897982122988867241, + 0.43424374934680255800, + 0.45913001198983233287, + 0.48361802694584102756, + 0.50768775753371660215, + 0.53131974364437562397, + 0.55449513263193254887, + 0.57719571005204581484, + 0.59940393024224289297, + 0.62110294673722640294, + 0.64227664250975951377, + 0.66290966002478059546, + 0.68298743109107922809, + 0.70249620649152707861, + 0.72142308537009891548, + 0.73975604435269475868, + 0.75748396638051363793, + 0.77459666924148337704, + 0.79108493379984836143, + 0.80694053195021761186, + 0.82215625436498040737, + 0.83672593816886873550, + 0.85064449476835027976, + 0.86390793819369047715, + 0.87651341448470526974, + 0.88845923287225699889, + 0.89974489977694003664, + 0.91037115695700429250, + 0.92034002547001242073, + 0.92965485742974005667, + 0.93832039777959288365, + 0.94634285837340290515, + 0.95373000642576113641, + 0.96049126870802028342, + 0.96663785155841656709, + 0.97218287474858179658, + 0.97714151463970571416, + 0.98153114955374010687, + 0.98537149959852037111, + 0.98868475754742947994, + 0.99149572117810613240, + 0.99383196321275502221, + 0.99572410469840718851, + 0.99720625937222195908, + 0.99831663531840739253, + 0.99909812496766759766, + 0.99959879967191068325, + 0.99987288812035761194, + 0.99998243035489159858 + }; + static double x_255[255] = + { + -0.99999759637974846462, + -0.99998243035489159858, + -0.99994399620705437576, + -0.99987288812035761194, + -0.99976049092443204733, + -0.99959879967191068325, + -0.99938033802502358193, + -0.99909812496766759766, + -0.99874561446809511470, + -0.99831663531840739253, + -0.99780535449595727456, + -0.99720625937222195908, + -0.99651414591489027385, + -0.99572410469840718851, + -0.99483150280062100052, + -0.99383196321275502221, + -0.99272134428278861533, + -0.99149572117810613240, + -0.99015137040077015918, + -0.98868475754742947994, + -0.98709252795403406719, + -0.98537149959852037111, + -0.98351865757863272876, + -0.98153114955374010687, + -0.97940628167086268381, + -0.97714151463970571416, + -0.97473445975240266776, + -0.97218287474858179658, + -0.96948465950245923177, + -0.96663785155841656709, + -0.96364062156981213252, + -0.96049126870802028342, + -0.95718821610986096274, + -0.95373000642576113641, + -0.95011529752129487656, + -0.94634285837340290515, + -0.94241156519108305981, + -0.93832039777959288365, + -0.93406843615772578800, + -0.92965485742974005667, + -0.92507893290707565236, + -0.92034002547001242073, + -0.91543758715576504064, + -0.91037115695700429250, + -0.90514035881326159519, + -0.89974489977694003664, + -0.89418456833555902286, + -0.88845923287225699889, + -0.88256884024734190684, + -0.87651341448470526974, + -0.87029305554811390585, + -0.86390793819369047715, + -0.85735831088623215653, + -0.85064449476835027976, + -0.84376688267270860104, + -0.83672593816886873550, + -0.82952219463740140018, + -0.82215625436498040737, + -0.81462878765513741344, + -0.80694053195021761186, + -0.79909229096084140180, + -0.79108493379984836143, + -0.78291939411828301639, + -0.77459666924148337704, + -0.76611781930376009072, + -0.75748396638051363793, + -0.74869629361693660282, + -0.73975604435269475868, + -0.73066452124218126133, + -0.72142308537009891548, + -0.71203315536225203459, + -0.70249620649152707861, + -0.69281376977911470289, + -0.68298743109107922809, + -0.67301883023041847920, + -0.66290966002478059546, + -0.65266166541001749610, + -0.64227664250975951377, + -0.63175643771119423041, + -0.62110294673722640294, + -0.61031811371518640016, + -0.59940393024224289297, + -0.58836243444766254143, + -0.57719571005204581484, + -0.56590588542365442262, + -0.55449513263193254887, + -0.54296566649831149049, + -0.53131974364437562397, + -0.51955966153745702199, + -0.50768775753371660215, + -0.49570640791876146017, + -0.48361802694584102756, + -0.47142506587165887693, + -0.45913001198983233287, + -0.44673538766202847374, + -0.43424374934680255800, + -0.42165768662616330006, + -0.40897982122988867241, + -0.39621280605761593918, + -0.38335932419873034692, + -0.37042208795007823014, + -0.35740383783153215238, + -0.34430734159943802278, + -0.33113539325797683309, + -0.31789081206847668318, + -0.30457644155671404334, + -0.29119514851824668196, + -0.27774982202182431507, + -0.26424337241092676194, + -0.25067873030348317661, + -0.23705884558982972721, + -0.22338668642896688163, + -0.20966523824318119477, + -0.19589750271110015392, + -0.18208649675925219825, + -0.16823525155220746498, + -0.15434681148137810869, + -0.14042423315256017459, + -0.12647058437230196685, + -0.11248894313318662575, + -0.098482396598119202090, + -0.084454040083710883710, + -0.070406976042855179063, + -0.056344313046592789972, + -0.042269164765363603212, + -0.028184648949745694339, + -0.014093886410782462614, + 0.0, + 0.014093886410782462614, + 0.028184648949745694339, + 0.042269164765363603212, + 0.056344313046592789972, + 0.070406976042855179063, + 0.084454040083710883710, + 0.098482396598119202090, + 0.11248894313318662575, + 0.12647058437230196685, + 0.14042423315256017459, + 0.15434681148137810869, + 0.16823525155220746498, + 0.18208649675925219825, + 0.19589750271110015392, + 0.20966523824318119477, + 0.22338668642896688163, + 0.23705884558982972721, + 0.25067873030348317661, + 0.26424337241092676194, + 0.27774982202182431507, + 0.29119514851824668196, + 0.30457644155671404334, + 0.31789081206847668318, + 0.33113539325797683309, + 0.34430734159943802278, + 0.35740383783153215238, + 0.37042208795007823014, + 0.38335932419873034692, + 0.39621280605761593918, + 0.40897982122988867241, + 0.42165768662616330006, + 0.43424374934680255800, + 0.44673538766202847374, + 0.45913001198983233287, + 0.47142506587165887693, + 0.48361802694584102756, + 0.49570640791876146017, + 0.50768775753371660215, + 0.51955966153745702199, + 0.53131974364437562397, + 0.54296566649831149049, + 0.55449513263193254887, + 0.56590588542365442262, + 0.57719571005204581484, + 0.58836243444766254143, + 0.59940393024224289297, + 0.61031811371518640016, + 0.62110294673722640294, + 0.63175643771119423041, + 0.64227664250975951377, + 0.65266166541001749610, + 0.66290966002478059546, + 0.67301883023041847920, + 0.68298743109107922809, + 0.69281376977911470289, + 0.70249620649152707861, + 0.71203315536225203459, + 0.72142308537009891548, + 0.73066452124218126133, + 0.73975604435269475868, + 0.74869629361693660282, + 0.75748396638051363793, + 0.76611781930376009072, + 0.77459666924148337704, + 0.78291939411828301639, + 0.79108493379984836143, + 0.79909229096084140180, + 0.80694053195021761186, + 0.81462878765513741344, + 0.82215625436498040737, + 0.82952219463740140018, + 0.83672593816886873550, + 0.84376688267270860104, + 0.85064449476835027976, + 0.85735831088623215653, + 0.86390793819369047715, + 0.87029305554811390585, + 0.87651341448470526974, + 0.88256884024734190684, + 0.88845923287225699889, + 0.89418456833555902286, + 0.89974489977694003664, + 0.90514035881326159519, + 0.91037115695700429250, + 0.91543758715576504064, + 0.92034002547001242073, + 0.92507893290707565236, + 0.92965485742974005667, + 0.93406843615772578800, + 0.93832039777959288365, + 0.94241156519108305981, + 0.94634285837340290515, + 0.95011529752129487656, + 0.95373000642576113641, + 0.95718821610986096274, + 0.96049126870802028342, + 0.96364062156981213252, + 0.96663785155841656709, + 0.96948465950245923177, + 0.97218287474858179658, + 0.97473445975240266776, + 0.97714151463970571416, + 0.97940628167086268381, + 0.98153114955374010687, + 0.98351865757863272876, + 0.98537149959852037111, + 0.98709252795403406719, + 0.98868475754742947994, + 0.99015137040077015918, + 0.99149572117810613240, + 0.99272134428278861533, + 0.99383196321275502221, + 0.99483150280062100052, + 0.99572410469840718851, + 0.99651414591489027385, + 0.99720625937222195908, + 0.99780535449595727456, + 0.99831663531840739253, + 0.99874561446809511470, + 0.99909812496766759766, + 0.99938033802502358193, + 0.99959879967191068325, + 0.99976049092443204733, + 0.99987288812035761194, + 0.99994399620705437576, + 0.99998243035489159858, + 0.99999759637974846462 + }; + static double x_511[511] = + { + -0.999999672956734384381, + -0.999997596379748464620, + -0.999992298136257588028, + -0.999982430354891598580, + -0.999966730098486276883, + -0.999943996207054375764, + -0.999913081144678282800, + -0.999872888120357611938, + -0.999822363679787739196, + -0.999760490924432047330, + -0.999686286448317731776, + -0.999598799671910683252, + -0.999497112467187190535, + -0.999380338025023581928, + -0.999247618943342473599, + -0.999098124967667597662, + -0.998931050830810562236, + -0.998745614468095114704, + -0.998541055697167906027, + -0.998316635318407392531, + -0.998071634524930323302, + -0.997805354495957274562, + -0.997517116063472399965, + -0.997206259372221959076, + -0.996872143485260161299, + -0.996514145914890273849, + -0.996131662079315037786, + -0.995724104698407188509, + -0.995290903148810302261, + -0.994831502800621000519, + -0.994345364356723405931, + -0.993831963212755022209, + -0.993290788851684966211, + -0.992721344282788615328, + -0.992123145530863117683, + -0.991495721178106132399, + -0.990838611958294243677, + -0.990151370400770159181, + -0.989433560520240838716, + -0.988684757547429479939, + -0.987904547695124280467, + -0.987092527954034067190, + -0.986248305913007552681, + -0.985371499598520371114, + -0.984461737328814534596, + -0.983518657578632728762, + -0.982541908851080604251, + -0.981531149553740106867, + -0.980486047876721339416, + -0.979406281670862683806, + -0.978291538324758539526, + -0.977141514639705714156, + -0.975955916702011753129, + -0.974734459752402667761, + -0.973476868052506926773, + -0.972182874748581796578, + -0.970852221732792443256, + -0.969484659502459231771, + -0.968079947017759947964, + -0.966637851558416567092, + -0.965158148579915665979, + -0.963640621569812132521, + -0.962085061904651475741, + -0.960491268708020283423, + -0.958859048710200221356, + -0.957188216109860962736, + -0.955478592438183697574, + -0.953730006425761136415, + -0.951942293872573589498, + -0.950115297521294876558, + -0.948248866934137357063, + -0.946342858373402905148, + -0.944397134685866648591, + -0.942411565191083059813, + -0.940386025573669721370, + -0.938320397779592883655, + -0.936214569916450806625, + -0.934068436157725787999, + -0.931881896650953639345, + -0.929654857429740056670, + -0.927387230329536696843, + -0.925078932907075652364, + -0.922729888363349241523, + -0.920340025470012420730, + -0.917909278499077501636, + -0.915437587155765040644, + -0.912924896514370590080, + -0.910371156957004292498, + -0.907776324115058903624, + -0.905140358813261595189, + -0.902463227016165675048, + -0.899744899776940036639, + -0.896985353188316590376, + -0.894184568335559022859, + -0.891342531251319871666, + -0.888459232872256998890, + -0.885534668997285008926, + -0.882568840247341906842, + -0.879561752026556262568, + -0.876513414484705269742, + -0.873423842480859310192, + -0.870293055548113905851, + -0.867121077859315215614, + -0.863907938193690477146, + -0.860653669904299969802, + -0.857358310886232156525, + -0.854021903545468625813, + -0.850644494768350279758, + -0.847226135891580884381, + -0.843766882672708601038, + -0.840266795261030442350, + -0.836725938168868735503, + -0.833144380243172624728, + -0.829522194637401400178, + -0.825859458783650001088, + -0.822156254364980407373, + -0.818412667287925807395, + -0.814628787655137413436, + -0.810804709738146594361, + -0.806940531950217611856, + -0.803036356819268687782, + -0.799092290960841401800, + -0.795108445051100526780, + -0.791084933799848361435, + -0.787021875923539422170, + -0.782919394118283016385, + -0.778777615032822744702, + -0.774596669241483377036, + -0.770376691217076824278, + -0.766117819303760090717, + -0.761820195689839149173, + -0.757483966380513637926, + -0.753109281170558142523, + -0.748696293616936602823, + -0.744245161011347082309, + -0.739756044352694758677, + -0.735229108319491547663, + -0.730664521242181261329, + -0.726062455075389632685, + -0.721423085370098915485, + -0.716746591245747095767, + -0.712033155362252034587, + -0.707282963891961103412, + -0.702496206491527078610, + -0.697673076273711232906, + -0.692813769779114702895, + -0.687918486947839325756, + -0.682987431091079228087, + -0.678020808862644517838, + -0.673018830230418479199, + -0.667981708447749702165, + -0.662909660024780595461, + -0.657802904699713735422, + -0.652661665410017496101, + -0.647486168263572388782, + -0.642276642509759513774, + -0.637033320510492495071, + -0.631756437711194230414, + -0.626446232611719746542, + -0.621102946737226402941, + -0.615726824608992638014, + -0.610318113715186400156, + -0.604877064481584353319, + -0.599403930242242892974, + -0.593898967210121954393, + -0.588362434447662541434, + -0.582794593837318850840, + -0.577195710052045814844, + -0.571566050525742833992, + -0.565905885423654422623, + -0.560215487612728441818, + -0.554495132631932548866, + -0.548745098662529448608, + -0.542965666498311490492, + -0.537157119515795115982, + -0.531319743644375623972, + -0.525453827336442687395, + -0.519559661537457021993, + -0.513637539655988578507, + -0.507687757533716602155, + -0.501710613415391878251, + -0.495706407918761460170, + -0.489675444004456155436, + -0.483618026945841027562, + -0.477534464298829155284, + -0.471425065871658876934, + -0.465290143694634735858, + -0.459130011989832332874, + -0.452944987140767283784, + -0.446735387662028473742, + -0.440501534168875795783, + -0.434243749346802558002, + -0.427962357921062742583, + -0.421657686626163300056, + -0.415330064175321663764, + -0.408979821229888672409, + -0.402607290368737092671, + -0.396212806057615939183, + -0.389796704618470795479, + -0.383359324198730346916, + -0.376901004740559344802, + -0.370422087950078230138, + -0.363922917266549655269, + -0.357403837831532152376, + -0.350865196458001209011, + -0.344307341599438022777, + -0.337730623318886219621, + -0.331135393257976833093, + -0.324522004605921855207, + -0.317890812068476683182, + -0.311242171836871800300, + -0.304576441556714043335, + -0.297893980296857823437, + -0.291195148518246681964, + -0.284480308042725577496, + -0.277749822021824315065, + -0.271004054905512543536, + -0.264243372410926761945, + -0.257468141491069790481, + -0.250678730303483176613, + -0.243875508178893021593, + -0.237058845589829727213, + -0.230229114119222177156, + -0.223386686428966881628, + -0.216531936228472628081, + -0.209665238243181194766, + -0.202786968183064697557, + -0.195897502711100153915, + -0.188997219411721861059, + -0.182086496759252198246, + -0.175165714086311475707, + -0.168235251552207464982, + -0.161295490111305257361, + -0.154346811481378108692, + -0.147389598111939940054, + -0.140424233152560174594, + -0.133451100421161601344, + -0.126470584372301966851, + -0.119483070065440005133, + -0.112488943133186625746, + -0.105488589749541988533, + -0.984823965981192020903E-01, + -0.914707508403553909095E-01, + -0.844540400837108837102E-01, + -0.774326523498572825675E-01, + -0.704069760428551790633E-01, + -0.633773999173222898797E-01, + -0.563443130465927899720E-01, + -0.493081047908686267156E-01, + -0.422691647653636032124E-01, + -0.352278828084410232603E-01, + -0.281846489497456943394E-01, + -0.211398533783310883350E-01, + -0.140938864107824626142E-01, + -0.704713845933674648514E-02, + +0.000000000000000000000, + +0.704713845933674648514E-02, + +0.140938864107824626142E-01, + +0.211398533783310883350E-01, + +0.281846489497456943394E-01, + +0.352278828084410232603E-01, + +0.422691647653636032124E-01, + +0.493081047908686267156E-01, + +0.563443130465927899720E-01, + +0.633773999173222898797E-01, + +0.704069760428551790633E-01, + +0.774326523498572825675E-01, + +0.844540400837108837102E-01, + +0.914707508403553909095E-01, + +0.984823965981192020903E-01, + +0.105488589749541988533, + +0.112488943133186625746, + +0.119483070065440005133, + +0.126470584372301966851, + +0.133451100421161601344, + +0.140424233152560174594, + +0.147389598111939940054, + +0.154346811481378108692, + +0.161295490111305257361, + +0.168235251552207464982, + +0.175165714086311475707, + +0.182086496759252198246, + +0.188997219411721861059, + +0.195897502711100153915, + +0.202786968183064697557, + +0.209665238243181194766, + +0.216531936228472628081, + +0.223386686428966881628, + +0.230229114119222177156, + +0.237058845589829727213, + +0.243875508178893021593, + +0.250678730303483176613, + +0.257468141491069790481, + +0.264243372410926761945, + +0.271004054905512543536, + +0.277749822021824315065, + +0.284480308042725577496, + +0.291195148518246681964, + +0.297893980296857823437, + +0.304576441556714043335, + +0.311242171836871800300, + +0.317890812068476683182, + +0.324522004605921855207, + +0.331135393257976833093, + +0.337730623318886219621, + +0.344307341599438022777, + +0.350865196458001209011, + +0.357403837831532152376, + +0.363922917266549655269, + +0.370422087950078230138, + +0.376901004740559344802, + +0.383359324198730346916, + +0.389796704618470795479, + +0.396212806057615939183, + +0.402607290368737092671, + +0.408979821229888672409, + +0.415330064175321663764, + +0.421657686626163300056, + +0.427962357921062742583, + +0.434243749346802558002, + +0.440501534168875795783, + +0.446735387662028473742, + +0.452944987140767283784, + +0.459130011989832332874, + +0.465290143694634735858, + +0.471425065871658876934, + +0.477534464298829155284, + +0.483618026945841027562, + +0.489675444004456155436, + +0.495706407918761460170, + +0.501710613415391878251, + +0.507687757533716602155, + +0.513637539655988578507, + +0.519559661537457021993, + +0.525453827336442687395, + +0.531319743644375623972, + +0.537157119515795115982, + +0.542965666498311490492, + +0.548745098662529448608, + +0.554495132631932548866, + +0.560215487612728441818, + +0.565905885423654422623, + +0.571566050525742833992, + +0.577195710052045814844, + +0.582794593837318850840, + +0.588362434447662541434, + +0.593898967210121954393, + +0.599403930242242892974, + +0.604877064481584353319, + +0.610318113715186400156, + +0.615726824608992638014, + +0.621102946737226402941, + +0.626446232611719746542, + +0.631756437711194230414, + +0.637033320510492495071, + +0.642276642509759513774, + +0.647486168263572388782, + +0.652661665410017496101, + +0.657802904699713735422, + +0.662909660024780595461, + +0.667981708447749702165, + +0.673018830230418479199, + +0.678020808862644517838, + +0.682987431091079228087, + +0.687918486947839325756, + +0.692813769779114702895, + +0.697673076273711232906, + +0.702496206491527078610, + +0.707282963891961103412, + +0.712033155362252034587, + +0.716746591245747095767, + +0.721423085370098915485, + +0.726062455075389632685, + +0.730664521242181261329, + +0.735229108319491547663, + +0.739756044352694758677, + +0.744245161011347082309, + +0.748696293616936602823, + +0.753109281170558142523, + +0.757483966380513637926, + +0.761820195689839149173, + +0.766117819303760090717, + +0.770376691217076824278, + +0.774596669241483377036, + +0.778777615032822744702, + +0.782919394118283016385, + +0.787021875923539422170, + +0.791084933799848361435, + +0.795108445051100526780, + +0.799092290960841401800, + +0.803036356819268687782, + +0.806940531950217611856, + +0.810804709738146594361, + +0.814628787655137413436, + +0.818412667287925807395, + +0.822156254364980407373, + +0.825859458783650001088, + +0.829522194637401400178, + +0.833144380243172624728, + +0.836725938168868735503, + +0.840266795261030442350, + +0.843766882672708601038, + +0.847226135891580884381, + +0.850644494768350279758, + +0.854021903545468625813, + +0.857358310886232156525, + +0.860653669904299969802, + +0.863907938193690477146, + +0.867121077859315215614, + +0.870293055548113905851, + +0.873423842480859310192, + +0.876513414484705269742, + +0.879561752026556262568, + +0.882568840247341906842, + +0.885534668997285008926, + +0.888459232872256998890, + +0.891342531251319871666, + +0.894184568335559022859, + +0.896985353188316590376, + +0.899744899776940036639, + +0.902463227016165675048, + +0.905140358813261595189, + +0.907776324115058903624, + +0.910371156957004292498, + +0.912924896514370590080, + +0.915437587155765040644, + +0.917909278499077501636, + +0.920340025470012420730, + +0.922729888363349241523, + +0.925078932907075652364, + +0.927387230329536696843, + +0.929654857429740056670, + +0.931881896650953639345, + +0.934068436157725787999, + +0.936214569916450806625, + +0.938320397779592883655, + +0.940386025573669721370, + +0.942411565191083059813, + +0.944397134685866648591, + +0.946342858373402905148, + +0.948248866934137357063, + +0.950115297521294876558, + +0.951942293872573589498, + +0.953730006425761136415, + +0.955478592438183697574, + +0.957188216109860962736, + +0.958859048710200221356, + +0.960491268708020283423, + +0.962085061904651475741, + +0.963640621569812132521, + +0.965158148579915665979, + +0.966637851558416567092, + +0.968079947017759947964, + +0.969484659502459231771, + +0.970852221732792443256, + +0.972182874748581796578, + +0.973476868052506926773, + +0.974734459752402667761, + +0.975955916702011753129, + +0.977141514639705714156, + +0.978291538324758539526, + +0.979406281670862683806, + +0.980486047876721339416, + +0.981531149553740106867, + +0.982541908851080604251, + +0.983518657578632728762, + +0.984461737328814534596, + +0.985371499598520371114, + +0.986248305913007552681, + +0.987092527954034067190, + +0.987904547695124280467, + +0.988684757547429479939, + +0.989433560520240838716, + +0.990151370400770159181, + +0.990838611958294243677, + +0.991495721178106132399, + +0.992123145530863117683, + +0.992721344282788615328, + +0.993290788851684966211, + +0.993831963212755022209, + +0.994345364356723405931, + +0.994831502800621000519, + +0.995290903148810302261, + +0.995724104698407188509, + +0.996131662079315037786, + +0.996514145914890273849, + +0.996872143485260161299, + +0.997206259372221959076, + +0.997517116063472399965, + +0.997805354495957274562, + +0.998071634524930323302, + +0.998316635318407392531, + +0.998541055697167906027, + +0.998745614468095114704, + +0.998931050830810562236, + +0.999098124967667597662, + +0.999247618943342473599, + +0.999380338025023581928, + +0.999497112467187190535, + +0.999598799671910683252, + +0.999686286448317731776, + +0.999760490924432047330, + +0.999822363679787739196, + +0.999872888120357611938, + +0.999913081144678282800, + +0.999943996207054375764, + +0.999966730098486276883, + +0.999982430354891598580, + +0.999992298136257588028, + +0.999997596379748464620, + +0.999999672956734384381 + }; + + if ( n == 1 ) + { + webbur::r8vec_copy ( n, x_001, x ); + } + else if ( n == 3 ) + { + webbur::r8vec_copy ( n, x_003, x ); + } + else if ( n == 7 ) + { + webbur::r8vec_copy ( n, x_007, x ); + } + else if ( n == 15 ) + { + webbur::r8vec_copy ( n, x_015, x ); + } + else if ( n == 31 ) + { + webbur::r8vec_copy ( n, x_031, x ); + } + else if ( n == 63 ) + { + webbur::r8vec_copy ( n, x_063, x ); + } + else if ( n == 127 ) + { + webbur::r8vec_copy ( n, x_127, x ); + } + else if ( n == 255 ) + { + webbur::r8vec_copy ( n, x_255, x ); + } + else if ( n == 511 ) + { + webbur::r8vec_copy ( n, x_511, x ); + } + else + { + std::cerr << "\n"; + std::cerr << "PATTERSON_LOOKUP_POINTS - Fatal error!\n"; + std::cerr << " Unexpected value of N = " << n << "\n"; + std::exit ( 1 ); + } + return; +} +//****************************************************************************80 + +void patterson_lookup_points_np ( int n, int np, double p[], double x[] ) + +//****************************************************************************80 +// +// Purpose: +// +// PATTERSON_LOOKUP_POINTS_NP looks up Patterson quadrature points. +// +// Discussion: +// +// Our convention is that the abscissas are numbered from left to right. +// +// The rule is defined on [-1,1], +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 December 2009 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Prem Kythe, Michael Schaeferkotter, +// Handbook of Computational Methods for Integration, +// Chapman and Hall, 2004, +// ISBN: 1-58488-428-2, +// LC: QA299.3.K98. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// Legal values are 1, 3, 7, 15, 31, 63, 127, 255 and 511. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double X[N], the abscissas. +// +{ + patterson_lookup_points ( n, x ); + + return; +} +//****************************************************************************80 + +void patterson_lookup_weights ( int n, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// PATTERSON_LOOKUP_WEIGHTS looks up Patterson quadrature weights. +// +// Discussion: +// +// The allowed orders are 1, 3, 7, 15, 31, 63, 127, 255 and 511. +// +// The weights are positive, symmetric and should sum to 2. +// +// The user must preallocate space for the output array W. +// +// These rules constitute a nested family. The rules can integrate exactly +// any polynomial of degree 1, 5, 11, 23, 47, 95, 191, 383 or 767, +// respectively. +// +// The data for N = 511 was supplied by Dirk Laurie, and is derived +// from a NAG Library function d01arf. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 14 September 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Prem Kythe, Michael Schaeferkotter, +// Handbook of Computational Methods for Integration, +// Chapman and Hall, 2004, +// ISBN: 1-58488-428-2, +// LC: QA299.3.K98. +// +// NAG Library Documentation, +// D01ARF, +// The Numerical Algorithms Group. +// +// Thomas Patterson, +// The Optimal Addition of Points to Quadrature Formulae, +// Mathematics of Computation, +// Volume 22, Number 104, October 1968, pages 847-856. +// +// Parameters: +// +// Input, int N, the order. +// Legal values are 1, 3, 7, 15, 31, 63, 127, 255 or 511. +// +// Output, double W[N], the weights. +// +{ + static double w_001[1] = + { + 2.0 + }; + static double w_003[3] = + { + 0.555555555555555555556, + 0.888888888888888888889, + 0.555555555555555555556 + }; + static double w_007[7] = + { + 0.104656226026467265194, + 0.268488089868333440729, + 0.401397414775962222905, + 0.450916538658474142345, + 0.401397414775962222905, + 0.268488089868333440729, + 0.104656226026467265194 + }; + static double w_015[15] = + { + 0.0170017196299402603390, + 0.0516032829970797396969, + 0.0929271953151245376859, + 0.134415255243784220360, + 0.171511909136391380787, + 0.200628529376989021034, + 0.219156858401587496404, + 0.225510499798206687386, + 0.219156858401587496404, + 0.200628529376989021034, + 0.171511909136391380787, + 0.134415255243784220360, + 0.0929271953151245376859, + 0.0516032829970797396969, + 0.0170017196299402603390 + }; + static double w_031[31] = + { + 0.00254478079156187441540, + 0.00843456573932110624631, + 0.0164460498543878109338, + 0.0258075980961766535646, + 0.0359571033071293220968, + 0.0464628932617579865414, + 0.0569795094941233574122, + 0.0672077542959907035404, + 0.0768796204990035310427, + 0.0857559200499903511542, + 0.0936271099812644736167, + 0.100314278611795578771, + 0.105669893580234809744, + 0.109578421055924638237, + 0.111956873020953456880, + 0.112755256720768691607, + 0.111956873020953456880, + 0.109578421055924638237, + 0.105669893580234809744, + 0.100314278611795578771, + 0.0936271099812644736167, + 0.0857559200499903511542, + 0.0768796204990035310427, + 0.0672077542959907035404, + 0.0569795094941233574122, + 0.0464628932617579865414, + 0.0359571033071293220968, + 0.0258075980961766535646, + 0.0164460498543878109338, + 0.00843456573932110624631, + 0.00254478079156187441540 + }; + static double w_063[63] = + { + 0.000363221481845530659694, + 0.00126515655623006801137, + 0.00257904979468568827243, + 0.00421763044155885483908, + 0.00611550682211724633968, + 0.00822300795723592966926, + 0.0104982469096213218983, + 0.0129038001003512656260, + 0.0154067504665594978021, + 0.0179785515681282703329, + 0.0205942339159127111492, + 0.0232314466399102694433, + 0.0258696793272147469108, + 0.0284897547458335486125, + 0.0310735511116879648799, + 0.0336038771482077305417, + 0.0360644327807825726401, + 0.0384398102494555320386, + 0.0407155101169443189339, + 0.0428779600250077344929, + 0.0449145316536321974143, + 0.0468135549906280124026, + 0.0485643304066731987159, + 0.0501571393058995374137, + 0.0515832539520484587768, + 0.0528349467901165198621, + 0.0539054993352660639269, + 0.0547892105279628650322, + 0.0554814043565593639878, + 0.0559784365104763194076, + 0.0562776998312543012726, + 0.0563776283603847173877, + 0.0562776998312543012726, + 0.0559784365104763194076, + 0.0554814043565593639878, + 0.0547892105279628650322, + 0.0539054993352660639269, + 0.0528349467901165198621, + 0.0515832539520484587768, + 0.0501571393058995374137, + 0.0485643304066731987159, + 0.0468135549906280124026, + 0.0449145316536321974143, + 0.0428779600250077344929, + 0.0407155101169443189339, + 0.0384398102494555320386, + 0.0360644327807825726401, + 0.0336038771482077305417, + 0.0310735511116879648799, + 0.0284897547458335486125, + 0.0258696793272147469108, + 0.0232314466399102694433, + 0.0205942339159127111492, + 0.0179785515681282703329, + 0.0154067504665594978021, + 0.0129038001003512656260, + 0.0104982469096213218983, + 0.00822300795723592966926, + 0.00611550682211724633968, + 0.00421763044155885483908, + 0.00257904979468568827243, + 0.00126515655623006801137, + 0.000363221481845530659694 + }; + static double w_127[127] = + { + 0.0000505360952078625176247, + 0.000180739564445388357820, + 0.000377746646326984660274, + 0.000632607319362633544219, + 0.000938369848542381500794, + 0.00128952408261041739210, + 0.00168114286542146990631, + 0.00210881524572663287933, + 0.00256876494379402037313, + 0.00305775341017553113613, + 0.00357289278351729964938, + 0.00411150397865469304717, + 0.00467105037211432174741, + 0.00524912345480885912513, + 0.00584344987583563950756, + 0.00645190005017573692280, + 0.00707248999543355546805, + 0.00770337523327974184817, + 0.00834283875396815770558, + 0.00898927578406413572328, + 0.00964117772970253669530, + 0.0102971169579563555237, + 0.0109557333878379016480, + 0.0116157233199551347270, + 0.0122758305600827700870, + 0.0129348396636073734547, + 0.0135915710097655467896, + 0.0142448773729167743063, + 0.0148936416648151820348, + 0.0155367755558439824399, + 0.0161732187295777199419, + 0.0168019385741038652709, + 0.0174219301594641737472, + 0.0180322163903912863201, + 0.0186318482561387901863, + 0.0192199051247277660193, + 0.0197954950480974994880, + 0.0203577550584721594669, + 0.0209058514458120238522, + 0.0214389800125038672465, + 0.0219563663053178249393, + 0.0224572658268160987071, + 0.0229409642293877487608, + 0.0234067774953140062013, + 0.0238540521060385400804, + 0.0242821652033365993580, + 0.0246905247444876769091, + 0.0250785696529497687068, + 0.0254457699654647658126, + 0.0257916269760242293884, + 0.0261156733767060976805, + 0.0264174733950582599310, + 0.0266966229274503599062, + 0.0269527496676330319634, + 0.0271855132296247918192, + 0.0273946052639814325161, + 0.0275797495664818730349, + 0.0277407021782796819939, + 0.0278772514766137016085, + 0.0279892182552381597038, + 0.0280764557938172466068, + 0.0281388499156271506363, + 0.0281763190330166021307, + 0.0281888141801923586938, + 0.0281763190330166021307, + 0.0281388499156271506363, + 0.0280764557938172466068, + 0.0279892182552381597038, + 0.0278772514766137016085, + 0.0277407021782796819939, + 0.0275797495664818730349, + 0.0273946052639814325161, + 0.0271855132296247918192, + 0.0269527496676330319634, + 0.0266966229274503599062, + 0.0264174733950582599310, + 0.0261156733767060976805, + 0.0257916269760242293884, + 0.0254457699654647658126, + 0.0250785696529497687068, + 0.0246905247444876769091, + 0.0242821652033365993580, + 0.0238540521060385400804, + 0.0234067774953140062013, + 0.0229409642293877487608, + 0.0224572658268160987071, + 0.0219563663053178249393, + 0.0214389800125038672465, + 0.0209058514458120238522, + 0.0203577550584721594669, + 0.0197954950480974994880, + 0.0192199051247277660193, + 0.0186318482561387901863, + 0.0180322163903912863201, + 0.0174219301594641737472, + 0.0168019385741038652709, + 0.0161732187295777199419, + 0.0155367755558439824399, + 0.0148936416648151820348, + 0.0142448773729167743063, + 0.0135915710097655467896, + 0.0129348396636073734547, + 0.0122758305600827700870, + 0.0116157233199551347270, + 0.0109557333878379016480, + 0.0102971169579563555237, + 0.00964117772970253669530, + 0.00898927578406413572328, + 0.00834283875396815770558, + 0.00770337523327974184817, + 0.00707248999543355546805, + 0.00645190005017573692280, + 0.00584344987583563950756, + 0.00524912345480885912513, + 0.00467105037211432174741, + 0.00411150397865469304717, + 0.00357289278351729964938, + 0.00305775341017553113613, + 0.00256876494379402037313, + 0.00210881524572663287933, + 0.00168114286542146990631, + 0.00128952408261041739210, + 0.000938369848542381500794, + 0.000632607319362633544219, + 0.000377746646326984660274, + 0.000180739564445388357820, + 0.0000505360952078625176247 + }; + static double w_255[255] = + { + 0.69379364324108267170E-05, + 0.25157870384280661489E-04, + 0.53275293669780613125E-04, + 0.90372734658751149261E-04, + 0.13575491094922871973E-03, + 0.18887326450650491366E-03, + 0.24921240048299729402E-03, + 0.31630366082226447689E-03, + 0.38974528447328229322E-03, + 0.46918492424785040975E-03, + 0.55429531493037471492E-03, + 0.64476204130572477933E-03, + 0.74028280424450333046E-03, + 0.84057143271072246365E-03, + 0.94536151685852538246E-03, + 0.10544076228633167722E-02, + 0.11674841174299594077E-02, + 0.12843824718970101768E-02, + 0.14049079956551446427E-02, + 0.15288767050877655684E-02, + 0.16561127281544526052E-02, + 0.17864463917586498247E-02, + 0.19197129710138724125E-02, + 0.20557519893273465236E-02, + 0.21944069253638388388E-02, + 0.23355251860571608737E-02, + 0.24789582266575679307E-02, + 0.26245617274044295626E-02, + 0.27721957645934509940E-02, + 0.29217249379178197538E-02, + 0.30730184347025783234E-02, + 0.32259500250878684614E-02, + 0.33803979910869203823E-02, + 0.35362449977167777340E-02, + 0.36933779170256508183E-02, + 0.38516876166398709241E-02, + 0.40110687240750233989E-02, + 0.41714193769840788528E-02, + 0.43326409680929828545E-02, + 0.44946378920320678616E-02, + 0.46573172997568547773E-02, + 0.48205888648512683476E-02, + 0.49843645647655386012E-02, + 0.51485584789781777618E-02, + 0.53130866051870565663E-02, + 0.54778666939189508240E-02, + 0.56428181013844441585E-02, + 0.58078616599775673635E-02, + 0.59729195655081658049E-02, + 0.61379152800413850435E-02, + 0.63027734490857587172E-02, + 0.64674198318036867274E-02, + 0.66317812429018878941E-02, + 0.67957855048827733948E-02, + 0.69593614093904229394E-02, + 0.71224386864583871532E-02, + 0.72849479805538070639E-02, + 0.74468208324075910174E-02, + 0.76079896657190565832E-02, + 0.77683877779219912200E-02, + 0.79279493342948491103E-02, + 0.80866093647888599710E-02, + 0.82443037630328680306E-02, + 0.84009692870519326354E-02, + 0.85565435613076896192E-02, + 0.87109650797320868736E-02, + 0.88641732094824942641E-02, + 0.90161081951956431600E-02, + 0.91667111635607884067E-02, + 0.93159241280693950932E-02, + 0.94636899938300652943E-02, + 0.96099525623638830097E-02, + 0.97546565363174114611E-02, + 0.98977475240487497440E-02, + 0.10039172044056840798E-01, + 0.10178877529236079733E-01, + 0.10316812330947621682E-01, + 0.10452925722906011926E-01, + 0.10587167904885197931E-01, + 0.10719490006251933623E-01, + 0.10849844089337314099E-01, + 0.10978183152658912470E-01, + 0.11104461134006926537E-01, + 0.11228632913408049354E-01, + 0.11350654315980596602E-01, + 0.11470482114693874380E-01, + 0.11588074033043952568E-01, + 0.11703388747657003101E-01, + 0.11816385890830235763E-01, + 0.11927026053019270040E-01, + 0.12035270785279562630E-01, + 0.12141082601668299679E-01, + 0.12244424981611985899E-01, + 0.12345262372243838455E-01, + 0.12443560190714035263E-01, + 0.12539284826474884353E-01, + 0.12632403643542078765E-01, + 0.12722884982732382906E-01, + 0.12810698163877361967E-01, + 0.12895813488012114694E-01, + 0.12978202239537399286E-01, + 0.13057836688353048840E-01, + 0.13134690091960152836E-01, + 0.13208736697529129966E-01, + 0.13279951743930530650E-01, + 0.13348311463725179953E-01, + 0.13413793085110098513E-01, + 0.13476374833816515982E-01, + 0.13536035934956213614E-01, + 0.13592756614812395910E-01, + 0.13646518102571291428E-01, + 0.13697302631990716258E-01, + 0.13745093443001896632E-01, + 0.13789874783240936517E-01, + 0.13831631909506428676E-01, + 0.13870351089139840997E-01, + 0.13906019601325461264E-01, + 0.13938625738306850804E-01, + 0.13968158806516938516E-01, + 0.13994609127619079852E-01, + 0.14017968039456608810E-01, + 0.14038227896908623303E-01, + 0.14055382072649964277E-01, + 0.14069424957813575318E-01, + 0.14080351962553661325E-01, + 0.14088159516508301065E-01, + 0.14092845069160408355E-01, + 0.14094407090096179347E-01, + 0.14092845069160408355E-01, + 0.14088159516508301065E-01, + 0.14080351962553661325E-01, + 0.14069424957813575318E-01, + 0.14055382072649964277E-01, + 0.14038227896908623303E-01, + 0.14017968039456608810E-01, + 0.13994609127619079852E-01, + 0.13968158806516938516E-01, + 0.13938625738306850804E-01, + 0.13906019601325461264E-01, + 0.13870351089139840997E-01, + 0.13831631909506428676E-01, + 0.13789874783240936517E-01, + 0.13745093443001896632E-01, + 0.13697302631990716258E-01, + 0.13646518102571291428E-01, + 0.13592756614812395910E-01, + 0.13536035934956213614E-01, + 0.13476374833816515982E-01, + 0.13413793085110098513E-01, + 0.13348311463725179953E-01, + 0.13279951743930530650E-01, + 0.13208736697529129966E-01, + 0.13134690091960152836E-01, + 0.13057836688353048840E-01, + 0.12978202239537399286E-01, + 0.12895813488012114694E-01, + 0.12810698163877361967E-01, + 0.12722884982732382906E-01, + 0.12632403643542078765E-01, + 0.12539284826474884353E-01, + 0.12443560190714035263E-01, + 0.12345262372243838455E-01, + 0.12244424981611985899E-01, + 0.12141082601668299679E-01, + 0.12035270785279562630E-01, + 0.11927026053019270040E-01, + 0.11816385890830235763E-01, + 0.11703388747657003101E-01, + 0.11588074033043952568E-01, + 0.11470482114693874380E-01, + 0.11350654315980596602E-01, + 0.11228632913408049354E-01, + 0.11104461134006926537E-01, + 0.10978183152658912470E-01, + 0.10849844089337314099E-01, + 0.10719490006251933623E-01, + 0.10587167904885197931E-01, + 0.10452925722906011926E-01, + 0.10316812330947621682E-01, + 0.10178877529236079733E-01, + 0.10039172044056840798E-01, + 0.98977475240487497440E-02, + 0.97546565363174114611E-02, + 0.96099525623638830097E-02, + 0.94636899938300652943E-02, + 0.93159241280693950932E-02, + 0.91667111635607884067E-02, + 0.90161081951956431600E-02, + 0.88641732094824942641E-02, + 0.87109650797320868736E-02, + 0.85565435613076896192E-02, + 0.84009692870519326354E-02, + 0.82443037630328680306E-02, + 0.80866093647888599710E-02, + 0.79279493342948491103E-02, + 0.77683877779219912200E-02, + 0.76079896657190565832E-02, + 0.74468208324075910174E-02, + 0.72849479805538070639E-02, + 0.71224386864583871532E-02, + 0.69593614093904229394E-02, + 0.67957855048827733948E-02, + 0.66317812429018878941E-02, + 0.64674198318036867274E-02, + 0.63027734490857587172E-02, + 0.61379152800413850435E-02, + 0.59729195655081658049E-02, + 0.58078616599775673635E-02, + 0.56428181013844441585E-02, + 0.54778666939189508240E-02, + 0.53130866051870565663E-02, + 0.51485584789781777618E-02, + 0.49843645647655386012E-02, + 0.48205888648512683476E-02, + 0.46573172997568547773E-02, + 0.44946378920320678616E-02, + 0.43326409680929828545E-02, + 0.41714193769840788528E-02, + 0.40110687240750233989E-02, + 0.38516876166398709241E-02, + 0.36933779170256508183E-02, + 0.35362449977167777340E-02, + 0.33803979910869203823E-02, + 0.32259500250878684614E-02, + 0.30730184347025783234E-02, + 0.29217249379178197538E-02, + 0.27721957645934509940E-02, + 0.26245617274044295626E-02, + 0.24789582266575679307E-02, + 0.23355251860571608737E-02, + 0.21944069253638388388E-02, + 0.20557519893273465236E-02, + 0.19197129710138724125E-02, + 0.17864463917586498247E-02, + 0.16561127281544526052E-02, + 0.15288767050877655684E-02, + 0.14049079956551446427E-02, + 0.12843824718970101768E-02, + 0.11674841174299594077E-02, + 0.10544076228633167722E-02, + 0.94536151685852538246E-03, + 0.84057143271072246365E-03, + 0.74028280424450333046E-03, + 0.64476204130572477933E-03, + 0.55429531493037471492E-03, + 0.46918492424785040975E-03, + 0.38974528447328229322E-03, + 0.31630366082226447689E-03, + 0.24921240048299729402E-03, + 0.18887326450650491366E-03, + 0.13575491094922871973E-03, + 0.90372734658751149261E-04, + 0.53275293669780613125E-04, + 0.25157870384280661489E-04, + 0.69379364324108267170E-05 + }; + static double w_511[511] = + { + 0.945715933950007048827E-06, + 0.345456507169149134898E-05, + 0.736624069102321668857E-05, + 0.125792781889592743525E-04, + 0.190213681905875816679E-04, + 0.266376412339000901358E-04, + 0.353751372055189588628E-04, + 0.451863674126296143105E-04, + 0.560319507856164252140E-04, + 0.678774554733972416227E-04, + 0.806899228014035293851E-04, + 0.944366322532705527066E-04, + 0.109085545645741522051E-03, + 0.124606200241498368482E-03, + 0.140970302204104791413E-03, + 0.158151830411132242924E-03, + 0.176126765545083195474E-03, + 0.194872642236641146532E-03, + 0.214368090034216937149E-03, + 0.234592462123925204879E-03, + 0.255525589595236862014E-03, + 0.277147657465187357459E-03, + 0.299439176850911730874E-03, + 0.322381020652862389664E-03, + 0.345954492129903871350E-03, + 0.370141402122251665232E-03, + 0.394924138246873704434E-03, + 0.420285716355361231823E-03, + 0.446209810101403247488E-03, + 0.472680758429262691232E-03, + 0.499683553312800484519E-03, + 0.527203811431658386125E-03, + 0.555227733977307579715E-03, + 0.583742058714979703847E-03, + 0.612734008012225209294E-03, + 0.642191235948505088403E-03, + 0.672101776960108194646E-03, + 0.702453997827572321358E-03, + 0.733236554224767912055E-03, + 0.764438352543882784191E-03, + 0.796048517297550871506E-03, + 0.828056364077226302608E-03, + 0.860451377808527848128E-03, + 0.893223195879324912340E-03, + 0.926361595613111283368E-03, + 0.959856485506936206261E-03, + 0.993697899638760857945E-03, + 0.102787599466367326179E-02, + 0.106238104885340071375E-02, + 0.109720346268191941940E-02, + 0.113233376051597664917E-02, + 0.116776259302858043685E-02, + 0.120348074001265964881E-02, + 0.123947911332878396534E-02, + 0.127574875977346947345E-02, + 0.131228086370221478128E-02, + 0.134906674928353113127E-02, + 0.138609788229672549700E-02, + 0.142336587141720519900E-02, + 0.146086246895890987689E-02, + 0.149857957106456636214E-02, + 0.153650921735128916170E-02, + 0.157464359003212166189E-02, + 0.161297501254393423070E-02, + 0.165149594771914570655E-02, + 0.169019899554346019117E-02, + 0.172907689054461607168E-02, + 0.176812249885838886701E-02, + 0.180732881501808930079E-02, + 0.184668895851282540913E-02, + 0.188619617015808475394E-02, + 0.192584380831993546204E-02, + 0.196562534503150547732E-02, + 0.200553436203751169944E-02, + 0.204556454679958293446E-02, + 0.208570968849203942640E-02, + 0.212596367401472533045E-02, + 0.216632048404649142727E-02, + 0.220677418916003329194E-02, + 0.224731894601603393082E-02, + 0.228794899365195972378E-02, + 0.232865864987842738864E-02, + 0.236944230779380495146E-02, + 0.241029443242563417382E-02, + 0.245120955750556483923E-02, + 0.249218228238276930060E-02, + 0.253320726907925325750E-02, + 0.257427923948908888092E-02, + 0.261539297272236109225E-02, + 0.265654330259352828314E-02, + 0.269772511525294586667E-02, + 0.273893334695947541201E-02, + 0.278016298199139435045E-02, + 0.282140905069222207923E-02, + 0.286266662764757868253E-02, + 0.290393082998878368175E-02, + 0.294519681581857582284E-02, + 0.298645978275408290247E-02, + 0.302771496658198544480E-02, + 0.306895764002069252174E-02, + 0.311018311158427546158E-02, + 0.315138672454287935858E-02, + 0.319256385597434736790E-02, + 0.323370991590184336368E-02, + 0.327482034651233969564E-02, + 0.331589062145094394706E-02, + 0.335691624518616761342E-02, + 0.339789275244138669739E-02, + 0.343881570768790591876E-02, + 0.347968070469521146972E-02, + 0.352048336613417922682E-02, + 0.356121934322919357659E-02, + 0.360188431545532431869E-02, + 0.364247399027690353194E-02, + 0.368298410292403911967E-02, + 0.372341041620379550870E-02, + 0.376374872034296338241E-02, + 0.380399483285952829161E-02, + 0.384414459846013158917E-02, + 0.388419388896099560998E-02, + 0.392413860322995774660E-02, + 0.396397466714742455513E-02, + 0.400369803358421688562E-02, + 0.404330468239442998549E-02, + 0.408279062042157838350E-02, + 0.412215188151643401528E-02, + 0.416138452656509745764E-02, + 0.420048464352596631772E-02, + 0.423944834747438184434E-02, + 0.427827178065384480959E-02, + 0.431695111253279479928E-02, + 0.435548253986604343679E-02, + 0.439386228676004195260E-02, + 0.443208660474124713206E-02, + 0.447015177282692726900E-02, + 0.450805409759782158001E-02, + 0.454578991327213285488E-02, + 0.458335558178039420335E-02, + 0.462074749284080687482E-02, + 0.465796206403469754658E-02, + 0.469499574088179046532E-02, + 0.473184499691503264714E-02, + 0.476850633375474925263E-02, + 0.480497628118194150483E-02, + 0.484125139721057135214E-02, + 0.487732826815870573054E-02, + 0.491320350871841897367E-02, + 0.494887376202437487201E-02, + 0.498433569972103029914E-02, + 0.501958602202842039909E-02, + 0.505462145780650125058E-02, + 0.508943876461803986674E-02, + 0.512403472879005351831E-02, + 0.515840616547381084096E-02, + 0.519254991870341614863E-02, + 0.522646286145300596306E-02, + 0.526014189569259311205E-02, + 0.529358395244259896547E-02, + 0.532678599182711857974E-02, + 0.535974500312596681161E-02, + 0.539245800482555593606E-02, + 0.542492204466865704951E-02, + 0.545713419970309863995E-02, + 0.548909157632945623482E-02, + 0.552079131034778706457E-02, + 0.555223056700346326850E-02, + 0.558340654103215637610E-02, + 0.561431645670402467678E-02, + 0.564495756786715368885E-02, + 0.567532715799029830087E-02, + 0.570542254020497332312E-02, + 0.573524105734693719020E-02, + 0.576478008199711142954E-02, + 0.579403701652197628421E-02, + 0.582300929311348057702E-02, + 0.585169437382850155033E-02, + 0.588008975062788803205E-02, + 0.590819294541511788161E-02, + 0.593600151007459827614E-02, + 0.596351302650963502011E-02, + 0.599072510668009471472E-02, + 0.601763539263978131522E-02, + 0.604424155657354634589E-02, + 0.607054130083414983949E-02, + 0.609653235797888692923E-02, + 0.612221249080599294931E-02, + 0.614757949239083790214E-02, + 0.617263118612191922727E-02, + 0.619736542573665996342E-02, + 0.622178009535701763157E-02, + 0.624587310952490748541E-02, + 0.626964241323744217671E-02, + 0.629308598198198836688E-02, + 0.631620182177103938227E-02, + 0.633898796917690165912E-02, + 0.636144249136619145314E-02, + 0.638356348613413709795E-02, + 0.640534908193868098342E-02, + 0.642679743793437438922E-02, + 0.644790674400605734710E-02, + 0.646867522080231481688E-02, + 0.648910111976869964292E-02, + 0.650918272318071200827E-02, + 0.652891834417652442012E-02, + 0.654830632678944064054E-02, + 0.656734504598007641819E-02, + 0.658603290766824937794E-02, + 0.660436834876456498276E-02, + 0.662234983720168509457E-02, + 0.663997587196526532519E-02, + 0.665724498312454708217E-02, + 0.667415573186258997654E-02, + 0.669070671050613006584E-02, + 0.670689654255504925648E-02, + 0.672272388271144108036E-02, + 0.673818741690825799086E-02, + 0.675328586233752529078E-02, + 0.676801796747810680683E-02, + 0.678238251212300746082E-02, + 0.679637830740619795480E-02, + 0.681000419582894688374E-02, + 0.682325905128564571420E-02, + 0.683614177908911221841E-02, + 0.684865131599535812903E-02, + 0.686078663022780697951E-02, + 0.687254672150094831613E-02, + 0.688393062104341470995E-02, + 0.689493739162046825872E-02, + 0.690556612755588354803E-02, + 0.691581595475321433825E-02, + 0.692568603071643155621E-02, + 0.693517554456992049848E-02, + 0.694428371707782549438E-02, + 0.695300980066273063177E-02, + 0.696135307942366551493E-02, + 0.696931286915342540213E-02, + 0.697688851735519545845E-02, + 0.698407940325846925786E-02, + 0.699088493783425207545E-02, + 0.699730456380953992594E-02, + 0.700333775568106572820E-02, + 0.700898401972830440494E-02, + 0.701424289402572916425E-02, + 0.701911394845431165171E-02, + 0.702359678471225911031E-02, + 0.702769103632498213858E-02, + 0.703139636865428709508E-02, + 0.703471247890678765907E-02, + 0.703763909614153052319E-02, + 0.704017598127683066242E-02, + 0.704232292709631209597E-02, + 0.704407975825415053266E-02, + 0.704544633127951476780E-02, + 0.704642253458020417748E-02, + 0.704700828844548013730E-02, + 0.704720354504808967346E-02, + 0.704700828844548013730E-02, + 0.704642253458020417748E-02, + 0.704544633127951476780E-02, + 0.704407975825415053266E-02, + 0.704232292709631209597E-02, + 0.704017598127683066242E-02, + 0.703763909614153052319E-02, + 0.703471247890678765907E-02, + 0.703139636865428709508E-02, + 0.702769103632498213858E-02, + 0.702359678471225911031E-02, + 0.701911394845431165171E-02, + 0.701424289402572916425E-02, + 0.700898401972830440494E-02, + 0.700333775568106572820E-02, + 0.699730456380953992594E-02, + 0.699088493783425207545E-02, + 0.698407940325846925786E-02, + 0.697688851735519545845E-02, + 0.696931286915342540213E-02, + 0.696135307942366551493E-02, + 0.695300980066273063177E-02, + 0.694428371707782549438E-02, + 0.693517554456992049848E-02, + 0.692568603071643155621E-02, + 0.691581595475321433825E-02, + 0.690556612755588354803E-02, + 0.689493739162046825872E-02, + 0.688393062104341470995E-02, + 0.687254672150094831613E-02, + 0.686078663022780697951E-02, + 0.684865131599535812903E-02, + 0.683614177908911221841E-02, + 0.682325905128564571420E-02, + 0.681000419582894688374E-02, + 0.679637830740619795480E-02, + 0.678238251212300746082E-02, + 0.676801796747810680683E-02, + 0.675328586233752529078E-02, + 0.673818741690825799086E-02, + 0.672272388271144108036E-02, + 0.670689654255504925648E-02, + 0.669070671050613006584E-02, + 0.667415573186258997654E-02, + 0.665724498312454708217E-02, + 0.663997587196526532519E-02, + 0.662234983720168509457E-02, + 0.660436834876456498276E-02, + 0.658603290766824937794E-02, + 0.656734504598007641819E-02, + 0.654830632678944064054E-02, + 0.652891834417652442012E-02, + 0.650918272318071200827E-02, + 0.648910111976869964292E-02, + 0.646867522080231481688E-02, + 0.644790674400605734710E-02, + 0.642679743793437438922E-02, + 0.640534908193868098342E-02, + 0.638356348613413709795E-02, + 0.636144249136619145314E-02, + 0.633898796917690165912E-02, + 0.631620182177103938227E-02, + 0.629308598198198836688E-02, + 0.626964241323744217671E-02, + 0.624587310952490748541E-02, + 0.622178009535701763157E-02, + 0.619736542573665996342E-02, + 0.617263118612191922727E-02, + 0.614757949239083790214E-02, + 0.612221249080599294931E-02, + 0.609653235797888692923E-02, + 0.607054130083414983949E-02, + 0.604424155657354634589E-02, + 0.601763539263978131522E-02, + 0.599072510668009471472E-02, + 0.596351302650963502011E-02, + 0.593600151007459827614E-02, + 0.590819294541511788161E-02, + 0.588008975062788803205E-02, + 0.585169437382850155033E-02, + 0.582300929311348057702E-02, + 0.579403701652197628421E-02, + 0.576478008199711142954E-02, + 0.573524105734693719020E-02, + 0.570542254020497332312E-02, + 0.567532715799029830087E-02, + 0.564495756786715368885E-02, + 0.561431645670402467678E-02, + 0.558340654103215637610E-02, + 0.555223056700346326850E-02, + 0.552079131034778706457E-02, + 0.548909157632945623482E-02, + 0.545713419970309863995E-02, + 0.542492204466865704951E-02, + 0.539245800482555593606E-02, + 0.535974500312596681161E-02, + 0.532678599182711857974E-02, + 0.529358395244259896547E-02, + 0.526014189569259311205E-02, + 0.522646286145300596306E-02, + 0.519254991870341614863E-02, + 0.515840616547381084096E-02, + 0.512403472879005351831E-02, + 0.508943876461803986674E-02, + 0.505462145780650125058E-02, + 0.501958602202842039909E-02, + 0.498433569972103029914E-02, + 0.494887376202437487201E-02, + 0.491320350871841897367E-02, + 0.487732826815870573054E-02, + 0.484125139721057135214E-02, + 0.480497628118194150483E-02, + 0.476850633375474925263E-02, + 0.473184499691503264714E-02, + 0.469499574088179046532E-02, + 0.465796206403469754658E-02, + 0.462074749284080687482E-02, + 0.458335558178039420335E-02, + 0.454578991327213285488E-02, + 0.450805409759782158001E-02, + 0.447015177282692726900E-02, + 0.443208660474124713206E-02, + 0.439386228676004195260E-02, + 0.435548253986604343679E-02, + 0.431695111253279479928E-02, + 0.427827178065384480959E-02, + 0.423944834747438184434E-02, + 0.420048464352596631772E-02, + 0.416138452656509745764E-02, + 0.412215188151643401528E-02, + 0.408279062042157838350E-02, + 0.404330468239442998549E-02, + 0.400369803358421688562E-02, + 0.396397466714742455513E-02, + 0.392413860322995774660E-02, + 0.388419388896099560998E-02, + 0.384414459846013158917E-02, + 0.380399483285952829161E-02, + 0.376374872034296338241E-02, + 0.372341041620379550870E-02, + 0.368298410292403911967E-02, + 0.364247399027690353194E-02, + 0.360188431545532431869E-02, + 0.356121934322919357659E-02, + 0.352048336613417922682E-02, + 0.347968070469521146972E-02, + 0.343881570768790591876E-02, + 0.339789275244138669739E-02, + 0.335691624518616761342E-02, + 0.331589062145094394706E-02, + 0.327482034651233969564E-02, + 0.323370991590184336368E-02, + 0.319256385597434736790E-02, + 0.315138672454287935858E-02, + 0.311018311158427546158E-02, + 0.306895764002069252174E-02, + 0.302771496658198544480E-02, + 0.298645978275408290247E-02, + 0.294519681581857582284E-02, + 0.290393082998878368175E-02, + 0.286266662764757868253E-02, + 0.282140905069222207923E-02, + 0.278016298199139435045E-02, + 0.273893334695947541201E-02, + 0.269772511525294586667E-02, + 0.265654330259352828314E-02, + 0.261539297272236109225E-02, + 0.257427923948908888092E-02, + 0.253320726907925325750E-02, + 0.249218228238276930060E-02, + 0.245120955750556483923E-02, + 0.241029443242563417382E-02, + 0.236944230779380495146E-02, + 0.232865864987842738864E-02, + 0.228794899365195972378E-02, + 0.224731894601603393082E-02, + 0.220677418916003329194E-02, + 0.216632048404649142727E-02, + 0.212596367401472533045E-02, + 0.208570968849203942640E-02, + 0.204556454679958293446E-02, + 0.200553436203751169944E-02, + 0.196562534503150547732E-02, + 0.192584380831993546204E-02, + 0.188619617015808475394E-02, + 0.184668895851282540913E-02, + 0.180732881501808930079E-02, + 0.176812249885838886701E-02, + 0.172907689054461607168E-02, + 0.169019899554346019117E-02, + 0.165149594771914570655E-02, + 0.161297501254393423070E-02, + 0.157464359003212166189E-02, + 0.153650921735128916170E-02, + 0.149857957106456636214E-02, + 0.146086246895890987689E-02, + 0.142336587141720519900E-02, + 0.138609788229672549700E-02, + 0.134906674928353113127E-02, + 0.131228086370221478128E-02, + 0.127574875977346947345E-02, + 0.123947911332878396534E-02, + 0.120348074001265964881E-02, + 0.116776259302858043685E-02, + 0.113233376051597664917E-02, + 0.109720346268191941940E-02, + 0.106238104885340071375E-02, + 0.102787599466367326179E-02, + 0.993697899638760857945E-03, + 0.959856485506936206261E-03, + 0.926361595613111283368E-03, + 0.893223195879324912340E-03, + 0.860451377808527848128E-03, + 0.828056364077226302608E-03, + 0.796048517297550871506E-03, + 0.764438352543882784191E-03, + 0.733236554224767912055E-03, + 0.702453997827572321358E-03, + 0.672101776960108194646E-03, + 0.642191235948505088403E-03, + 0.612734008012225209294E-03, + 0.583742058714979703847E-03, + 0.555227733977307579715E-03, + 0.527203811431658386125E-03, + 0.499683553312800484519E-03, + 0.472680758429262691232E-03, + 0.446209810101403247488E-03, + 0.420285716355361231823E-03, + 0.394924138246873704434E-03, + 0.370141402122251665232E-03, + 0.345954492129903871350E-03, + 0.322381020652862389664E-03, + 0.299439176850911730874E-03, + 0.277147657465187357459E-03, + 0.255525589595236862014E-03, + 0.234592462123925204879E-03, + 0.214368090034216937149E-03, + 0.194872642236641146532E-03, + 0.176126765545083195474E-03, + 0.158151830411132242924E-03, + 0.140970302204104791413E-03, + 0.124606200241498368482E-03, + 0.109085545645741522051E-03, + 0.944366322532705527066E-04, + 0.806899228014035293851E-04, + 0.678774554733972416227E-04, + 0.560319507856164252140E-04, + 0.451863674126296143105E-04, + 0.353751372055189588628E-04, + 0.266376412339000901358E-04, + 0.190213681905875816679E-04, + 0.125792781889592743525E-04, + 0.736624069102321668857E-05, + 0.345456507169149134898E-05, + 0.945715933950007048827E-06, + }; + + if ( n == 1 ) + { + webbur::r8vec_copy ( n, w_001, w ); + } + else if ( n == 3 ) + { + webbur::r8vec_copy ( n, w_003, w ); + } + else if ( n == 7 ) + { + webbur::r8vec_copy ( n, w_007, w ); + } + else if ( n == 15 ) + { + webbur::r8vec_copy ( n, w_015, w ); + } + else if ( n == 31 ) + { + webbur::r8vec_copy ( n, w_031, w ); + } + else if ( n == 63 ) + { + webbur::r8vec_copy ( n, w_063, w ); + } + else if ( n == 127 ) + { + webbur::r8vec_copy ( n, w_127, w ); + } + else if ( n == 255 ) + { + webbur::r8vec_copy ( n, w_255, w ); + } + else if ( n == 511 ) + { + webbur::r8vec_copy ( n, w_511, w ); + } + else + { + std::cerr << "\n"; + std::cerr << "PATTERSON_LOOKUP_WEIGHTS - Fatal error!\n"; + std::cerr << " Unexpected value of N = " << n << ".\n"; + std::exit ( 1 ); + } + return; +} +//****************************************************************************80 + +void patterson_lookup_weights_np ( int n, int np, double p[], double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// PATTERSON_LOOKUP_WEIGHTS_NP looks up Patterson quadrature weights. +// +// Discussion: +// +// The allowed orders are 1, 3, 7, 15, 31, 63, 127, 255 and 511. +// +// The weights are positive, symmetric and should sum to 2. +// +// The user must preallocate space for the output array W. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 25 April 2011 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Milton Abramowitz, Irene Stegun, +// Handbook of Mathematical Functions, +// National Bureau of Standards, 1964, +// ISBN: 0-486-61272-4, +// LC: QA47.A34. +// +// Arthur Stroud, Don Secrest, +// Gaussian Quadrature Formulas, +// Prentice Hall, 1966, +// LC: QA299.4G3S7. +// +// Parameters: +// +// Input, int N, the order. +// Legal values are 1, 3, 7, 15, 31, 63, 127, 255 or 511. +// +// Input, int NP, the number of parameters. +// +// Input, double P[NP], parameters which are not needed by this function. +// +// Output, double W[N], the weights. +// +{ + patterson_lookup_weights ( n, w ); + + return; +} +//****************************************************************************80 + +int point_radial_tol_unique_count ( int m, int n, double a[], double tol, + int *seed ) + +//****************************************************************************80 +// +// Purpose: +// +// POINT_RADIAL_TOL_UNIQUE_COUNT counts the tolerably unique points. +// +// Discussion: +// +// The input data is an M x N array A, representing the M-dimensional +// coordinates of N points. +// +// The output is the number of tolerably unique points in the list. +// +// This program performs the same task as POINT_TOL_UNIQUE_COUNT. +// But that program is guaranteed to use N^2 comparisons. +// +// It is hoped that this function, on the other hand, will tend +// to use O(N) comparisons after an O(NLog(N)) sort. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 24 July 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows. +// +// Input, int N, the number of columns. +// +// Input, double A[M*N], the array of N columns of data. +// +// Input, double TOL, a tolerance for equality. +// +// Input/output, int *SEED, a seed for the random +// number generator. +// +// Output, int POINT_RADIAL_TOL_UNIQUE_COUNT, the number of tolerably +// unique points. +// +{ + double dist; + int hi; + int i; + int *indx; + int j; + int k; + double *r; + bool *unique; + int unique_num; + double *w; + double w_sum; + double *z; + + if ( n <= 0 ) + { + unique_num = 0; + return unique_num; + } +// +// Assign a base point Z randomly in the convex hull. +// + w = webbur::r8vec_uniform_01_new ( n, seed ); + w_sum = webbur::r8vec_sum ( n, w ); + for ( j = 0; j < n; j++ ) + { + w[j] = w[j] / w_sum; + } + + z = new double[m]; + for ( i = 0; i < m; i++ ) + { + z[i] = 0.0; + for ( j = 0; j < n; j++ ) + { + z[i] = z[i] + a[i+j*m] * w[j]; + } + } +// +// Compute the radial distance R of each point to Z. +// + r = new double[n]; + + for ( j = 0; j < n; j++ ) + { + r[j] = 0.0; + for ( i = 0; i < m; i++ ) + { + r[j] = r[j] + std::pow ( a[i+j*m] - z[i], 2 ); + } + r[j] = std::sqrt ( r[j] ); + } +// +// Implicitly sort the R array. +// + indx = webbur::r8vec_sort_heap_index_a_new ( n, r ); +// +// To determine if a point I is tolerably unique, we only have to check +// whether it is distinct from all points J such that R(I) <= R(J) <= R(J)+TOL. +// + unique_num = 0; + + unique = new bool[n]; + for ( i = 0; i < n; i++ ) + { + unique[i] = true; + } + + for ( i = 0; i < n; i++ ) + { + if ( unique[indx[i]] ) + { +// +// Point INDX(I) is unique, in that no earlier point is near it. +// + unique_num = unique_num + 1; +// +// Look for later points which are close to point INDX(I) +// in terms of R. +// + hi = i; + + while ( hi < n - 1 ) + { + if ( r[indx[i]] + tol < r[indx[hi+1]] ) + { + break; + } + hi = hi + 1; + } +// +// Points INDX(I+1) through INDX(HI) have an R value close to +// point INDX(I). Are they truly close to point INDEX(I)? +// + for ( j = i + 1; j <= hi; j++ ) + { + if ( unique[indx[j]] ) + { + dist = 0.0; + for ( k = 0; k < m; k++ ) + { + dist = dist + std::pow ( a[k+indx[i]*m] - a[k+indx[j]*m], 2 ); + } + dist = std::sqrt ( dist ); + + if ( dist <= tol ) + { + unique[indx[j]] = false; + } + } + } + } + } + + delete [] indx; + delete [] r; + delete [] unique; + delete [] w; + delete [] z; + + return unique_num; +} +//****************************************************************************80 + +void point_radial_tol_unique_count_inc1 ( int m, int n1, double a1[], + double tol, int *seed, double z[], double r1[], int indx1[], bool unique1[], + int *unique_num1 ) + +//****************************************************************************80 +// +// Purpose: +// +// POINT_RADIAL_TOL_UNIQUE_COUNT_INC1 counts the tolerably unique points. +// +// Discussion: +// +// The input data includes an M x N1 array A1 of a set of N1 +// "permanent" points and N2 "temporary" points. +// +// This is a two step version of POINT_RADIAL_TOL_UNIQUE_COUNT_INC. +// +// This means that we want to identify the tolerably unique points +// among the permanent points before processing the temporary points. +// +// If many sets of temporary data are considered, this function will +// do a lot of unnecessary work resorting the permanent data; it would +// be possible to avoid repetitions of that work at the expense of saving +// various work vectors. This function accepts the overhead of the +// repeated calculations for the benefit of only having to "remember" +// the number of unique points discovered. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 01 October 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows. +// +// Input, int N1, the number of permanent points. +// +// Input, double A1[M*N1], the permanent points. +// +// Input, double TOL, a tolerance for equality. +// +// Input/output, int *SEED, a seed for the random +// number generator. +// +// Output, double Z[M], a random base vector used to +// linearly sort the data. +// +// Output, double R1[N1], the scalar values assigned to +// the data for sorting. +// +// Output, int INDX1[N1], the ascending sort index +// for A1. +// +// Output, bool UNIQUE1[N1], is TRUE for each unique permanent point. +// +// Output, int *UNIQUE_NUM1, the number of tolerably +// unique permanent points. +// +{ + double dist; + int hi; + int i; + int j; + int j1; + int k1; + double *w; + double w_sum; +// +// Assign a base point Z randomly in the convex hull of the permanent points. +// + w = webbur::r8vec_uniform_01_new ( n1, seed ); + w_sum = webbur::r8vec_sum ( n1, w ); + for ( j1 = 0; j1 < n1; j1++ ) + { + w[j1] = w[j1] / w_sum; + } + for ( i = 0; i < m; i++ ) + { + z[i] = 0.0; + for ( j1 = 0; j1 < n1; j1++ ) + { + z[i] = z[i] + a1[i+j1*m] * w[j1]; + } + } +// +// Initialize the permanent point data. +// + for ( j1 = 0; j1 < n1; j1++ ) + { + r1[j1] = 0.0; + for ( i = 0; i < m; i++ ) + { + r1[j1] = r1[j1] + std::pow ( a1[i+j1*m] - z[i], 2 ); + } + r1[j1] = std::sqrt ( r1[j1] ); + } + webbur::r8vec_sort_heap_index_a ( n1, r1, indx1 ); + + *unique_num1 = 0; + for ( j1 = 0; j1 < n1; j1++ ) + { + unique1[j1] = true; + } +// +// STEP 1: +// Compare PERMANENT POINTS to PERMANENT POINTS. +// + for ( j1 = 0; j1 < n1; j1++ ) + { + if ( unique1[indx1[j1]] ) + { + *unique_num1 = *unique_num1 + 1; + + hi = j1; + + while ( hi < n1 - 1 ) + { + if ( r1[indx1[j1]] + tol < r1[indx1[hi+1]] ) + { + break; + } + hi = hi + 1; + } + + for ( k1 = j1 + 1; k1 <= hi; k1++ ) + { + if ( unique1[indx1[k1]] ) + { + dist = 0.0; + for ( i = 0; i < m; i++ ) + { + dist = dist + std::pow ( a1[i+indx1[j1]*m] - a1[i+indx1[k1]*m], 2 ); + } + dist = std::sqrt ( dist ); + + if ( dist <= tol ) + { + unique1[indx1[k1]] = false; + } + } + } + } + } + + delete [] w; + + return; +} +//****************************************************************************80 + +void point_radial_tol_unique_count_inc2 ( int m, int n1, double a1[], int n2, + double a2[], double tol, double z[], double r1[], int indx1[], bool unique1[], + int *unique_num2 ) + +//****************************************************************************80 +// +// Purpose: +// +// POINT_RADIAL_TOL_UNIQUE_COUNT_INC2 counts the tolerably unique points. +// +// Discussion: +// +// The input data includes an M x N1 array A1 and an M x N2 array A2, +// representing the M-dimensional coordinates of a set of N1 +// "permanent" points and N2 "temporary" points. +// +// This is an "incremental" version of POINT_RADIAL_TOL_UNIQUE_COUNT. +// +// This means that we want to identify the tolerably unique points +// among the permanent points before processing the temporary points. +// +// If many sets of temporary data are considered, this function will +// do a lot of unnecessary work resorting the permanent data; it would +// be possible to avoid repetitions of that work at the expense of saving +// various work vectors. This function accepts the overhead of the +// repeated calculations for the benefit of only having to "remember" +// the number of unique points discovered. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 01 October 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows. +// +// Input, int N1, the number of permanent points. +// +// Input, double A1[M*N1], the permanent points. +// +// Input, int N2, the number of temporary points. +// +// Input, double A2[M*N2], the temporary points. +// +// Input, double TOL, a tolerance for equality. +// +// Input, double Z[M], a random base vector used to +// linearly sort the data. +// +// Input, double R1[N1], the scalar values assigned to +// the data for sorting. +// +// Input, int INDX1[N1], the ascending sort index +// for A1. +// +// Input, bool UNIQUE1[N1], is TRUE for each unique permanent point. +// +// Output, int *UNIQUE_NUM2, the number of additional +// tolerably unique points if the temporary points are included. +// +{ + double dist; + int hi; + int i; + int *indx2; + int j; + int j1; + int j2; + int j2_hi; + int j2_lo; + int k1; + int k2; + double r_hi; + double r_lo; + double *r2; + bool *unique2; +// +// Initialize the temporary point data. +// + r2 = new double[n2]; + for ( j2 = 0; j2 < n2; j2++ ) + { + r2[j2] = 0.0; + for ( i = 0; i < m; i++ ) + { + r2[j2] = r2[j2] + std::pow ( a2[i+j2*m] - z[i], 2 ); + } + r2[j2] = std::sqrt ( r2[j2] ); + } + + indx2 = new int[n2]; + webbur::r8vec_sort_heap_index_a ( n2, r2, indx2 ); + + unique2 = new bool[n2]; + for ( j2 = 0; j2 < n2; j2++ ) + { + unique2[j2] = true; + } + + *unique_num2 = 0; +// +// STEP 2: +// Use PERMANENT points to eliminate TEMPORARY points. +// + for ( j1 = 0; j1 < n1; j1++ ) + { + if ( unique1[indx1[j1]] ) + { + r_lo = r1[indx1[j1]] - tol; + r_hi = r1[indx1[j1]] + tol; + + webbur::r8vec_index_sorted_range ( n2, r2, indx2, r_lo, r_hi, + &j2_lo, &j2_hi ); + + for ( j2 = j2_lo; j2 <= j2_hi; j2++ ) + { + if ( unique2[indx2[j2]] ) + { + dist = 0.0; + for ( i = 0; i < m; i++ ) + { + dist = dist + std::pow ( a1[i+indx1[j1]*m] + - a2[i+indx2[j2]*m], 2 ); + } + dist = std::sqrt ( dist ); + if ( dist <= tol ) + { + unique2[indx2[j2]] = false; + } + } + } + } + } +// +// STEP 3: +// Use TEMPORARY points to eliminate TEMPORARY points. +// + for ( j2 = 0; j2 < n2; j2++ ) + { + if ( unique2[indx2[j2]] ) + { + *unique_num2 = *unique_num2 + 1; + + hi = j2; + + while ( hi < n2 - 1 ) + { + if ( r2[indx2[j2]] + tol < r2[indx2[hi+1]] ) + { + break; + } + hi = hi + 1; + } + + for ( k2 = j2 + 1; k2 <= hi; k2++ ) + { + if ( unique2[indx2[k2]] ) + { + dist = 0.0; + for ( i = 0; i < m; i++ ) + { + dist = dist + std::pow ( a2[i+indx2[j2]*m] - a2[i+indx2[k2]*m], 2 ); + } + dist = std::sqrt ( dist ); + + if ( dist <= tol ) + { + unique2[indx2[k2]] = false; + } + } + } + } + } + delete [] indx2; + delete [] r2; + delete [] unique2; + + return; +} +//****************************************************************************80 + +int point_radial_tol_unique_index ( int m, int n, double a[], double tol, + int *seed, int undx[], int xdnu[] ) + +//****************************************************************************80 +// +// Purpose: +// +// POINT_RADIAL_TOL_UNIQUE_INDEX indexes the tolerably unique points. +// +// Discussion: +// +// The input data is an M x N array A, representing the M-dimensional +// coordinates of N points. +// +// The output is: +// * the number of tolerably unique points in the list; +// * the index, in the list of unique items, of the representatives +// of each point; +// * the index, in A, of the tolerably unique representatives. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 28 July 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows. +// +// Input, int N, the number of columns. +// +// Input, double A[M*N], the array of N columns of data. +// +// Input, double TOL, a tolerance for equality. +// +// Input/output, int SEED, a seed for the random +// number generator. +// +// Output, int UNDX[UNIQUE_NUM], the index, in A, of the +// tolerably unique points. +// +// Output, int XDNU[N], the index, in UNDX, of the +// tolerably unique point that "represents" this point. +// +// Output, int POINT_RADIAL_TOL_UNIQUE_INDEX, the number of tolerably +// unique points. +// +{ + double dist; + int hi; + int i; + int *indx; + int j; + int k; + double *r; + bool *unique; + int unique_num; + double *w; + double w_sum; + double *z; + + if ( n <= 0 ) + { + unique_num = 0; + return unique_num; + } +// +// Assign a base point Z randomly in the convex hull. +// + w = webbur::r8vec_uniform_01_new ( n, seed ); + w_sum = webbur::r8vec_sum ( n, w ); + for ( j = 0; j < n; j++ ) + { + w[j] = w[j] / w_sum; + } + + z = new double[m]; + for ( i = 0; i < m; i++ ) + { + z[i] = 0.0; + for ( j = 0; j < n; j++ ) + { + z[i] = z[i] + a[i+j*m] * w[j]; + } + } +// +// Compute the radial distance R of each point to Z. +// + r = new double[n]; + + for ( j = 0; j < n; j++ ) + { + r[j] = 0.0; + for ( i = 0; i < m; i++ ) + { + r[j] = r[j] + std::pow ( a[i+j*m] - z[i], 2 ); + } + r[j] = std::sqrt ( r[j] ); + } +// +// Implicitly sort the R array. +// + indx = webbur::r8vec_sort_heap_index_a_new ( n, r ); +// +// To determine if a point I is tolerably unique, we only have to check +// whether it is distinct from all points J such that R(I) <= R(J) <= R(J)+TOL. +// + unique_num = 0; + + unique = new bool[n]; + for ( i = 0; i < n; i++ ) + { + unique[i] = true; + } + + for ( i = 0; i < n; i++ ) + { + if ( unique[indx[i]] ) + { +// +// Point INDX(I) is unique, in that no earlier point is near it. +// + xdnu[indx[i]] = unique_num; + undx[unique_num] = indx[i]; + unique_num = unique_num + 1; +// +// Look for later points which are close to point INDX(I) +// in terms of R. +// + hi = i; + + while ( hi < n - 1 ) + { + if ( r[indx[i]] + tol < r[indx[hi+1]] ) + { + break; + } + hi = hi + 1; + } +// +// Points INDX(I+1) through INDX(HI) have an R value close to +// point INDX(I). Are they truly close to point INDEX(I)? +// + for ( j = i + 1; j <= hi; j++ ) + { + if ( unique[indx[j]] ) + { + dist = 0.0; + for ( k = 0; k < m; k++ ) + { + dist = dist + std::pow ( a[k+indx[i]*m] - a[k+indx[j]*m], 2 ); + } + dist = std::sqrt ( dist ); + + if ( dist <= tol ) + { + unique[indx[j]] = false; + xdnu[indx[j]] = xdnu[indx[i]]; + } + } + } + } + } + + delete [] indx; + delete [] r; + delete [] unique; + delete [] w; + delete [] z; + + return unique_num; +} +//****************************************************************************80 + +void point_radial_tol_unique_index_inc1 ( int m, int n1, double a1[], + double tol, int *seed, double z[], double r1[], int indx1[], bool unique1[], + int *unique_num1, int undx1[], int xdnu1[] ) + +//****************************************************************************80 +// +// Purpose: +// +// POINT_RADIAL_TOL_UNIQUE_INDEX_INC1 indexes the tolerably unique points. +// +// Discussion: +// +// The input data includes an M x N1 array A1 of +// "permanent" points. +// +// This is a two step version of POINT_RADIAL_TOL_UNIQUE_INDEX_INC. +// +// The output is: +// * the number of tolerably unique points in the list; +// * the index, in the list of unique items, of the representatives +// of each point; +// * the index, in A1, of the tolerably unique representatives. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 02 October 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows. +// +// Input, int N1, the number of permanent points. +// +// Input, double A1[M*N1], the permanent points. +// +// Input, double TOL, a tolerance for equality. +// +// Input/output, int *SEED, a seed for the random +// number generator. +// +// Output, double Z[M], a random base vector used to +// linearly sort the data. +// +// Output, double R1[N1], the scalar values assigned to +// the data for sorting. +// +// Output, int INDX1[N1], the ascending sort index for A1. +// +// Output, bool UNIQUE1[N1], is TRUE for unique permanent points. +// +// Output, int *UNIQUE_NUM1, the number of tolerably unique points +// with just the permanent points. +// +// Output, int UNDX1[UNIQUE_NUM1], the index, in A1, of the tolerably +// unique points. +// +// Output, int XDNU1[N1], the index, in UNDX1, of the tolerably unique +// point that "represents" this point. +// +{ + double dist; + int hi; + int i; + int j; + int j1; + int k1; + double *w; + double w_sum; +// +// Assign a base point Z randomly in the convex hull of the permanent points. +// + w = webbur::r8vec_uniform_01_new ( n1, seed ); + w_sum = webbur::r8vec_sum ( n1, w ); + for ( j1 = 0; j1 < n1; j1++ ) + { + w[j1] = w[j1] / w_sum; + } + + for ( i = 0; i < m; i++ ) + { + z[i] = 0.0; + for ( j1 = 0; j1 < n1; j1++ ) + { + z[i] = z[i] + a1[i+j1*m] * w[j1]; + } + } +// +// Initialize the permanent point data. +// + for ( j1 = 0; j1 < n1; j1++ ) + { + r1[j1] = 0.0; + for ( i = 0; i < m; i++ ) + { + r1[j1] = r1[j1] + std::pow ( a1[i+j1*m] - z[i], 2 ); + } + r1[j1] = std::sqrt ( r1[j1] ); + } + webbur::r8vec_sort_heap_index_a ( n1, r1, indx1 ); + + *unique_num1 = 0; + for ( j1 = 0; j1 < n1; j1++ ) + { + unique1[j1] = true; + } +// +// STEP 1: +// Compare PERMANENT POINTS to PERMANENT POINTS. +// + for ( j1 = 0; j1 < n1; j1++ ) + { + if ( unique1[indx1[j1]] ) + { + xdnu1[indx1[j1]] = *unique_num1; + undx1[*unique_num1] = indx1[j1]; + *unique_num1 = *unique_num1 + 1; + + hi = j1; + + while ( hi < n1 - 1 ) + { + if ( r1[indx1[j1]] + tol < r1[indx1[hi+1]] ) + { + break; + } + hi = hi + 1; + } + + for ( k1 = j1 + 1; k1 <= hi; k1++ ) + { + if ( unique1[indx1[k1]] ) + { + dist = 0.0; + for ( i = 0; i < m; i++ ) + { + dist = dist + std::pow ( a1[i+indx1[j1]*m] - a1[i+indx1[k1]*m], 2 ); + } + dist = std::sqrt ( dist ); + + if ( dist <= tol ) + { + unique1[indx1[k1]] = false; + xdnu1[indx1[k1]] = xdnu1[indx1[j1]]; + } + } + } + } + } + + delete [] w; + + return; +} +//****************************************************************************80 + +void point_radial_tol_unique_index_inc2 ( int m, int n1, double a1[], int n2, + double a2[], double tol, double z[], double r1[], int indx1[], bool unique1[], + int unique_num1, int undx1[], int xdnu1[], double r2[], + int indx2[], bool unique2[], int *unique_num2, int undx2[], int xdnu2[] ) + +//****************************************************************************80 +// +// Purpose: +// +// POINT_RADIAL_TOL_UNIQUE_INDEX_INC2 indexes unique temporary points. +// +// Discussion: +// +// The input data includes an M x N1 array A1 and an M x N2 array A2, +// representing the M-dimensional coordinates of a set of N1 +// "permanent" points and N2 "temporary" points. +// +// For notation, we use "A" to describe the M x (N1+N2) array that would be +// formed by starting with A1 and appending A2. +// +// The output is: +// * the number of tolerably unique points in the list; +// * the index, in the list of unique items, of the representatives +// of each point; +// * the index, in A, of the tolerably unique representatives. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 08 October 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows. +// +// Input, int N1, the number of permanent points. +// +// Input, double A1[M*N1], the permanent points. +// +// Input, int N2, the number of temporary points. +// +// Input, double A2[M*N2], the temporary points. +// +// Input, double TOL, a tolerance for equality. +// +// Input, double Z[M], a random base vector used to +// linearly sort the data. +// +// Input, double R1[N1], the scalar values assigned to +// A1 for sorting. +// +// Input, int INDX1[N1], the ascending sort index for A1. +// +// Input, bool UNIQUE1[N1], is TRUE for unique permanent points. +// +// Input, int UNIQUE_NUM1, the number of tolerably unique permanent points. +// +// Input, int UNDX1[UNIQUE_NUM1], +// the index in A1 of the tolerably unique permanent points. +// +// Input, int XDNU1[N1], the index in UNDX1 +// of the tolerably unique permanent point that "represents" this point. +// +// Output, double R2[N2], the scalar values assigned to +// A2 for sorting. +// +// Output, int INDX2[N2], the ascending sort index for A2. +// +// Output, bool UNIQUE2[N2], is TRUE for unique temporary points. +// +// Output, int *UNIQUE_NUM2, the number +// of tolerably unique temporary points. +// +// Output, int UNDX2[UNIQUE_NUM2], +// the index in A2 of the tolerably unique points, incremented by N1. +// +// Output, int XDNU2[N2], the index, in UNDX1 +// or UNDX2, of the tolerably unique point that "represents" this +// temporary point. If the value represents an index in UNDX2, this +// can be inferred by the fact that its value is greater than or +// equal to UNIQUE_NUM1. To reference UNDX2, the value should then be +// decremented by UNIQUE_NUM1. +// +{ + double dist; + int hi; + int i; + int j; + int j1; + int j2; + int j2_hi; + int j2_lo; + int k1; + int k2; + double r_hi; + double r_lo; +// +// Initialize the temporary point data. +// + for ( j2 = 0; j2 < n2; j2++ ) + { + r2[j2] = 0.0; + for ( i = 0; i < m; i++ ) + { + r2[j2] = r2[j2] + std::pow ( a2[i+j2*m] - z[i], 2 ); + } + r2[j2] = std::sqrt ( r2[j2] ); + } + + webbur::r8vec_sort_heap_index_a ( n2, r2, indx2 ); + + for ( j2 = 0; j2 < n2; j2++ ) + { + unique2[j2] = true; + } + + *unique_num2 = 0; +// +// STEP 2: +// Use PERMANENT points to eliminate TEMPORARY points. +// + for ( j1 = 0; j1 < n1; j1++ ) + { + if ( unique1[indx1[j1]] ) + { + r_lo = r1[indx1[j1]] - tol; + r_hi = r1[indx1[j1]] + tol; + + webbur::r8vec_index_sorted_range ( n2, r2, indx2, r_lo, r_hi, + &j2_lo, &j2_hi ); + + for ( j2 = j2_lo; j2 <= j2_hi; j2++ ) + { + if ( unique2[indx2[j2]] ) + { + dist = 0.0; + for ( i = 0; i < m; i++ ) + { + dist = dist + std::pow ( a1[i+indx1[j1]*m] + - a2[i+indx2[j2]*m], 2 ); + } + dist = std::sqrt ( dist ); + if ( dist <= tol ) + { + unique2[indx2[j2]] = false; + xdnu2[indx2[j2]] = xdnu1[indx1[j1]]; + } + } + } + } + } +// +// STEP 3: +// Use TEMPORARY points to eliminate TEMPORARY points. +// + for ( j2 = 0; j2 < n2; j2++ ) + { + if ( unique2[indx2[j2]] ) + { + xdnu2[indx2[j2]] = unique_num1 + *unique_num2; + undx2[*unique_num2] = indx2[j2] + n1; + *unique_num2 = *unique_num2 + 1; + + hi = j2; + + while ( hi < n2 - 1 ) + { + if ( r2[indx2[j2]] + tol < r2[indx2[hi+1]] ) + { + break; + } + hi = hi + 1; + } + + for ( k2 = j2 + 1; k2 <= hi; k2++ ) + { + if ( unique2[indx2[k2]] ) + { + dist = 0.0; + for ( i = 0; i < m; i++ ) + { + dist = dist + std::pow ( a2[i+indx2[j2]*m] - a2[i+indx2[k2]*m], 2 ); + } + dist = std::sqrt ( dist ); + + if ( dist <= tol ) + { + unique2[indx2[k2]] = false; + xdnu2[indx2[k2]] = xdnu2[indx2[j2]]; + } + } + } + } + } + + return; +} +//****************************************************************************80 + +void point_radial_tol_unique_index_inc3 ( int m, int n1, double a1[], + double r1[], int indx1[], bool unique1[], int unique_num1, int undx1[], + int xdnu1[], int n2, double a2[], double r2[], int indx2[], bool unique2[], + int unique_num2, int undx2[], int xdnu2[], int *n3, double a3[], double r3[], + int indx3[], bool unique3[], int *unique_num3, int undx3[], int xdnu3[] ) + +//****************************************************************************80 +// +// Purpose: +// +// POINT_RADIAL_TOL_UNIQUE_INDEX_INC3 merges index data. +// +// Discussion: +// +// This function may be called after *INDEX_INC1 has created index +// information for the permanent data, and *INDEX_INC2 has created +// augmenting information for a set of temporary data which now is +// to be merged with the permanent data. +// +// The function merges the data and index information to create a +// new "permanent" data set. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 08 October 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows. +// +// Input, int N1, the number of permanent points. +// +// Input, double A1[M*N1], the permanent points. +// +// Input, double R1[N1], the scalar values assigned to +// the data for sorting. +// +// Input, int INDX1[N1], the ascending sort index +// for A1. +// +// Input, bool UNIQUE1[N1], is TRUE for each unique permanent point. +// +// Input, int UNIQUE_NUM1, the number +// of tolerably unique points with just the permanent points. +// +// Input, int UNDX1[UNIQUE_NUM1], +// the index in A1 of the tolerably unique points. +// +// Input, int XDNU1[N1], the index in UNDX1 +// of the tolerably unique point that "represents" this point. +// +// Input, int N2, the number of temporary points. +// +// Input, double A2[M,N2], the temporary points. +// +// Input, double R2[N2], the scalar values assigned to +// the data for sorting. +// +// Input, int INDX2[N2], the ascending sort index +// for A2. +// +// Input, bool UNIQUE2[N2], is TRUE for each unique temporary point. +// +// Input, int UNIQUE_NUM2, the number +// of tolerably unique temporary points. +// +// Input, int UNDX2[UNIQUE_NUM2], +// the index in A2 of the tolerably unique points, incremented by UNIQUE_NUM1. +// +// Input, int XDNU2[N2], the index in UNDX1 or UNDX2 +// of the tolerably unique point that "represents" this point. +// +// Output, int *N3, the number of permanent points. +// +// Output, double A3[M,N3], the permanent points. +// +// Output, double R3[N3], the scalar values assigned to +// the data for sorting. +// +// Output, int INDX3[N3], the ascending sort index +// for A3. +// +// Output, bool UNIQUE3[N3], is TRUE for each unique permanent point. +// +// Output, int *UNIQUE_NUM3, the number +// of tolerably unique points. +// +// Output, int UNDX3[UNIQUE_NUM3], +// the index in A3 of the tolerably unique points. +// +// Output, int XDNU3[N3], the index in UNDX3 +// of the tolerably unique point that "represents" this point. +// +{ + int i; + int i1; + int i2; + int i3; + double v1; + double v2; + + *n3 = n1 + n2; + + for ( i1 = 0; i1 < n1; i1++ ) + { + for ( i = 0; i < m; i++ ) + { + a3[i+i1*m] = a1[i+i1*m]; + } + } + for ( i2 = 0; i2 < n2; i2++ ) + { + i3 = n1 + i2; + for ( i = 0; i < m; i++ ) + { + a3[i+i3*m] = a2[i+i2*m]; + } + } + for ( i1 = 0; i1 < n1; i1++ ) + { + r3[i1]= r1[i1]; + } + for ( i2 = 0; i2 < n2; i2++ ) + { + i3 = n1 + i2; + r3[i3] = r2[i2]; + } +// +// Interleave the two INDX arrays so that INDX3 presents the entries +// of A3 in ascending R3 order. +// + i1 = 0; + i2 = 0; + + for ( i3 = 0; i3 < *n3; i3++ ) + { + if ( i1 < n1 ) + { + v1 = r1[indx1[i1]]; + } + else + { + v1 = r8_huge ( ); + } + + if ( i2 < n2 ) + { + v2 = r2[indx2[i2]]; + } + else + { + v2 = r8_huge ( ); + } + + if ( v1 <= v2 ) + { + indx3[i3] = indx1[i1]; + i1 = i1 + 1; + } + else + { + indx3[i3] = indx2[i2] + n1; + i2 = i2 + 1; + } + } + + *unique_num3 = unique_num1 + unique_num2; + + for ( i1 = 0; i1 < n1; i1++ ) + { + unique3[i1] = unique1[i1]; + } + for ( i2 = 0; i2 < n2; i2++ ) + { + i3 = n1 + i2; + unique3[i3] = unique2[i2]; + } +// +// The entries in UNDX2 were already incremented by N2 if they pointed +// to an entry of A2, so all entries in UNDX2 correctly index A3. +// + for ( i1 = 0; i1 < unique_num1; i1++ ) + { + undx3[i1] = undx1[i1]; + } + for ( i2 = 0; i2 < unique_num2; i2++ ) + { + i3 = unique_num1 + i2; + undx3[i3] = undx2[i2]; + } +// +// Note that the entries of XDNU2 were already incremented by N2 +// so that they correctly index A3, not A2. +// + for ( i1 = 0; i1 < n1; i1++ ) + { + xdnu3[i1] = xdnu1[i1]; + } + for ( i2 = 0; i2 < n2; i2++ ) + { + i3 = n1 + i2; + xdnu3[i3] = xdnu2[i2]; + } + + return; +} +//****************************************************************************80 + +void point_unique_index ( int m, int n, double a[], int unique_num, int undx[], + int xdnu[] ) + +//****************************************************************************80 +// +// Purpose: +// +// POINT_UNIQUE_INDEX indexes unique points. +// +// Discussion: +// +// An R8COL is an M by N array of R8's, regarded as an array of N columns, +// each of length M. +// +// The goal of this routine is to determine a vector UNDX, +// which points to the unique elements of A, in sorted order, +// and a vector XDNU, which identifies, for each entry of A, the index of +// the unique sorted element of A. +// +// This is all done with index vectors, so that the elements of +// A are never moved. +// +// The first step of the algorithm requires the indexed sorting +// of A, which creates arrays INDX and XDNI. (If all the entries +// of A are unique, then these arrays are the same as UNDX and XDNU.) +// +// We then use INDX to examine the entries of A in sorted order, +// noting the unique entries, creating the entries of XDNU and +// UNDX as we go. +// +// Once this process has been completed, the vector A could be +// replaced by a compressed vector XU, containing the unique entries +// of A in sorted order, using the formula +// +// XU(*) = A(UNDX(*)). +// +// We could then, if we wished, reconstruct the entire vector A, or +// any element of it, by index, as follows: +// +// A(I) = XU(XDNU(I)). +// +// We could then replace A by the combination of XU and XDNU. +// +// Later, when we need the I-th entry of A, we can locate it as +// the XDNU(I)-th entry of XU. +// +// Here is an example of a vector A, the sort and inverse sort +// index vectors, and the unique sort and inverse unique sort vectors +// and the compressed unique sorted vector. +// +// I A Indx Xdni XU Undx Xdnu +// ----+-----+-----+-----+--------+-----+-----+ +// 0 | 11. 0 0 | 11. 0 0 +// 1 | 22. 2 4 | 22. 1 1 +// 2 | 11. 5 1 | 33. 3 0 +// 3 | 33. 8 7 | 55. 4 2 +// 4 | 55. 1 8 | 3 +// 5 | 11. 6 2 | 0 +// 6 | 22. 7 5 | 1 +// 7 | 22. 3 6 | 1 +// 8 | 11. 4 3 | 0 +// +// INDX(2) = 3 means that sorted item(2) is A(3). +// XDNI(2) = 5 means that A(2) is sorted item(5). +// +// UNDX(3) = 4 means that unique sorted item(3) is at A(4). +// XDNU(8) = 2 means that A(8) is at unique sorted item(2). +// +// XU(XDNU(I))) = A(I). +// XU(I) = A(UNDX(I)). +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 July 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the dimension of the data values. +// +// Input, int N, the number of data values, +// +// Input, double A[M*N], the data values. +// +// Input, int UNIQUE_NUM, the number of unique values in A. +// This value is only required for languages in which the size of +// UNDX must be known in advance. +// +// Output, int UNDX[UNIQUE_NUM], the UNDX vector. +// +// Output, int XDNU[N], the XDNU vector. +// +{ + double diff; + int i; + int *indx; + int j; + int k; +// +// Implicitly sort the array. +// + indx = webbur::r8col_sort_heap_index_a ( m, n, a ); +// +// Walk through the implicitly sorted array. +// + i = 0; + + j = 0; + undx[j] = indx[i]; + + xdnu[indx[i]] = j; + + for ( i = 1; i < n; i++ ) + { + diff = 0.0; + for ( k = 0; k < m; k++ ) + { + diff = webbur::r8_max ( diff, + webbur::r8_abs ( a[k+indx[i]*m] - a[k+undx[j]*m] ) ); + } + if ( 0.0 < diff ) + { + j = j + 1; + undx[j] = indx[i]; + } + xdnu[indx[i]] = j; + } + delete [] indx; + + return; +} +//****************************************************************************80 + +void product_mixed_weight ( int dim_num, int order_1d[], int order_nd, + int rule[], double alpha[], double beta[], double weight_nd[] ) + +//****************************************************************************80 +// +// Purpose: +// +// PRODUCT_MIXED_WEIGHT computes the weights of a mixed product rule. +// +// Discussion: +// +// This routine computes the weights for a quadrature rule which is +// a product of 1D rules of varying order and kind. +// +// The user must preallocate space for the output array WEIGHT_ND. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 11 February 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int DIM_NUM, the spatial dimension. +// +// Input, int ORDER_1D[DIM_NUM], the order of the 1D rules. +// +// Input, int ORDER_ND, the order of the product rule. +// +// Input, int RULE[DIM_NUM], the rule in each dimension. +// 1, "CC", Clenshaw Curtis, Closed Fully Nested rule. +// 2, "F2", Fejer Type 2, Open Fully Nested rule. +// 3, "GP", Gauss Patterson, Open Fully Nested rule. +// 4, "GL", Gauss Legendre, Open Weakly Nested rule. +// 5, "GH", Gauss Hermite, Open Weakly Nested rule. +// 6, "GGH", Generalized Gauss Hermite, Open Weakly Nested rule. +// 7, "LG", Gauss Laguerre, Open Non Nested rule. +// 8, "GLG", Generalized Gauss Laguerre, Open Non Nested rule. +// 9, "GJ", Gauss Jacobi, Open Non Nested rule. +// 10, "GW", Golub Welsch, (presumed) Open Non Nested rule. +// 11, "CC_SE", Clenshaw Curtis Slow Exponential, Closed Fully Nested rule. +// 12, "F2_SE", Fejer Type 2 Slow Exponential, Open Fully Nested rule. +// 13, "GP_SE", Gauss Patterson Slow Exponential, Open Fully Nested rule. +// 14, "CC_ME", Clenshaw Curtis Moderate Exponential, Closed Fully Nested rule. +// 15, "F2_ME", Fejer Type 2 Moderate Exponential, Open Fully Nested rule. +// 16, "GP_ME", Gauss Patterson Moderate Exponential, Open Fully Nested rule. +// 17, "CCN", Clenshaw Curtis Nested, Linear, Closed Fully Nested rule. +// +// Input, double ALPHA[DIM_NUM], BETA[DIM_NUM], parameters used for +// Generalized Gauss Hermite, Generalized Gauss Laguerre, +// and Gauss Jacobi rules. +// +// Output, double WEIGHT_ND[ORDER_ND], the product rule weights. +// +{ + int dim; + int i; + double *weight_1d; + + for ( i = 0; i < order_nd; i++ ) + { + weight_nd[i] = 1.0; + } + + for ( dim = 0; dim < dim_num; dim++ ) + { + weight_1d = new double[order_1d[dim]]; + + if ( rule[dim] == 1 ) + { + webbur::clenshaw_curtis_compute_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 2 ) + { + webbur::fejer2_compute_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 3 ) + { + webbur::patterson_lookup_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 4 ) + { + webbur::legendre_compute_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 5 ) + { + webbur::hermite_compute_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 6 ) + { + webbur::gen_hermite_compute_weights ( order_1d[dim], alpha[dim], weight_1d ); + } + else if ( rule[dim] == 7 ) + { + webbur::laguerre_compute_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 8 ) + { + webbur::gen_laguerre_compute_weights ( order_1d[dim], alpha[dim], weight_1d ); + } + else if ( rule[dim] == 9 ) + { + webbur::jacobi_compute_weights ( order_1d[dim], alpha[dim], beta[dim], weight_1d ); + } + else if ( rule[dim] == 10 ) + { + std::cerr << "\n"; + std::cerr << "PRODUCT_MIXED_WEIGHT - Fatal error!\n"; + std::cerr << " Do not know how to set weights for rule 10.\n"; + std::exit ( 1 ); + } + else if ( rule[dim] == 11 ) + { + webbur::clenshaw_curtis_compute_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 12 ) + { + webbur::fejer2_compute_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 13 ) + { + webbur::patterson_lookup_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 14 ) + { + webbur::clenshaw_curtis_compute_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 15 ) + { + webbur::fejer2_compute_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 16 ) + { + webbur::patterson_lookup_weights ( order_1d[dim], weight_1d ); + } + else if ( rule[dim] == 17 ) + { + webbur::ccn_compute_weights ( order_1d[dim], weight_1d ); + } + else + { + std::cerr << "\n"; + std::cerr << "PRODUCT_MIXED_WEIGHT - Fatal error!\n"; + std::cerr << " Unexpected value of RULE[" << dim << "] = " + << rule[dim] << ".\n"; + std::exit ( 1 ); + } + + webbur::r8vec_direct_product2 ( dim, order_1d[dim], weight_1d, + dim_num, order_nd, weight_nd ); + + delete [] weight_1d; + } + return; +} +//****************************************************************************80 + +double r8_abs ( double x ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_ABS returns the absolute value of an R8. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, double X, the quantity whose absolute value is desired. +// +// Output, double R8_ABS, the absolute value of X. +// +{ + double value; + + if ( 0.0 <= x ) + { + value = x; + } + else + { + value = -x; + } + return value; +} +//****************************************************************************80 + +double r8_ceiling ( double x ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_CEILING rounds an R8 "up" (towards +oo) to the next integer. +// +// Example: +// +// X R8_CEILING(X) +// +// -1.1 -1.0 +// -1.0 -1.0 +// -0.9 0.0 +// -0.1 0.0 +// 0.0 0.0 +// 0.1 1.0 +// 0.9 1.0 +// 1.0 1.0 +// 1.1 2.0 +// 2.9 3.0 +// 3.0 3.0 +// 3.14159 4.0 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 01 April 2004 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, double X, the number whose ceiling is desired. +// +// Output, double R8_CEILING, the ceiling of X. +// +{ + double value; + + value = ( int ) x; + + if ( value < x ) + { + value = value + 1.0; + } + + return value; +} +//****************************************************************************80 + +double r8_choose ( int n, int k ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_CHOOSE computes the binomial coefficient C(N,K) as an R8. +// +// Discussion: +// +// The value is calculated in such a way as to avoid overflow and +// roundoff. The calculation is done in R8 arithmetic. +// +// The formula used is: +// +// C(N,K) = N! / ( K! * (N-K)! ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 24 March 2008 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// ML Wolfson, HV Wright, +// Algorithm 160: +// Combinatorial of M Things Taken N at a Time, +// Communications of the ACM, +// Volume 6, Number 4, April 1963, page 161. +// +// Parameters: +// +// Input, int N, K, the values of N and K. +// +// Output, double R8_CHOOSE, the number of combinations of N +// things taken K at a time. +// +{ + int i; + int mn; + int mx; + int value; + + mn = webbur::i4_min ( k, n - k ); + + if ( mn < 0 ) + { + value = 0.0; + } + else if ( mn == 0 ) + { + value = 1.0; + } + else + { + mx = webbur::i4_max ( k, n - k ); + value = ( double ) ( mx + 1 ); + + for ( i = 2; i <= mn; i++ ) + { + value = ( value * ( double ) ( mx + i ) ) / ( double ) i; + } + } + return value; +} +//****************************************************************************80 + +double r8_epsilon ( ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_EPSILON returns the R8 roundoff unit. +// +// Discussion: +// +// The roundoff unit is a number R which is a power of 2 with the +// property that, to the precision of the computer's arithmetic, +// 1 < 1 + R +// but +// 1 = ( 1 + R / 2 ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 February 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Output, double R8_EPSILON, the R8 round-off unit. +// +{ + double value; + + value = 1.0; + + while ( 1.0 < ( double ) ( 1.0 + value ) ) + { + value = value / 2.0; + } + + value = 2.0 * value; + + return value; +} +//****************************************************************************80 + +double r8_factorial ( int n ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_FACTORIAL computes the factorial of N. +// +// Discussion: +// +// factorial ( N ) = product ( 1 <= I <= N ) I +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 16 January 1999 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the argument of the factorial function. +// If N is less than 1, the function value is returned as 1. +// +// Output, double R8_FACTORIAL, the factorial function. +// +{ + int i; + double value; + + value = 1.0; + + for ( i = 1; i <= n; i++ ) + { + value = value * ( double ) ( i ); + } + + return value; +} +//****************************************************************************80 + +double r8_factorial2 ( int n ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_FACTORIAL2 computes the double factorial function. +// +// Discussion: +// +// FACTORIAL2( N ) = Product ( N * (N-2) * (N-4) * ... * 2 ) (N even) +// = Product ( N * (N-2) * (N-4) * ... * 1 ) (N odd) +// +// Example: +// +// N FACTORIAL2(N) +// +// 0 1 +// 1 1 +// 2 2 +// 3 3 +// 4 8 +// 5 15 +// 6 48 +// 7 105 +// 8 384 +// 9 945 +// 10 3840 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 January 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the argument of the double factorial +// function. If N is less than 1, R8_FACTORIAL2 is returned as 1.0. +// +// Output, double R8_FACTORIAL2, the double factorial function. +// +{ + int n_copy; + double value; + + value = 1.0; + + if ( n < 1 ) + { + return value; + } + + n_copy = n; + + while ( 1 < n_copy ) + { + value = value * ( double ) n_copy; + n_copy = n_copy - 2; + } + + return value; +} +//****************************************************************************80 + +double r8_floor ( double x ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_FLOOR rounds an R8 "down" (towards -infinity) to the next integer. +// +// Example: +// +// X R8_FLOOR(X) +// +// -1.1 -2.0 +// -1.0 -1.0 +// -0.9 -1.0 +// -0.1 -1.0 +// 0.0 0.0 +// 0.1 0.0 +// 0.9 0.0 +// 1.0 1.0 +// 1.1 1.0 +// 2.9 2.0 +// 3.0 3.0 +// 3.14159 3.0 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 15 April 2007 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, double X, the number whose floor is desired. +// +// Output, double R8_FLOOR, the floor of X. +// +{ + double value; + + value = ( int ) x; + + if ( x < value ) + { + value = value - 1.0; + } + + return value; +} +//****************************************************************************80 + +double r8_gamma ( double x ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_GAMMA evaluates Gamma(X) for a real argument. +// +// Discussion: +// +// This routine calculates the gamma function for a real argument X. +// +// Computation is based on an algorithm outlined in reference 1. +// The program uses rational functions that approximate the gamma +// function to at least 20 significant decimal digits. Coefficients +// for the approximation over the interval (1,2) are unpublished. +// Those for the approximation for 12 <= X are from reference 2. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 January 2008 +// +// Author: +// +// Original FORTRAN77 version by William Cody, Laura Stoltz. +// C++ version by John Burkardt. +// +// Reference: +// +// William Cody, +// An Overview of Software Development for Special Functions, +// in Numerical Analysis Dundee, 1975, +// edited by GA Watson, +// Lecture Notes in Mathematics 506, +// Springer, 1976. +// +// John Hart, Ward Cheney, Charles Lawson, Hans Maehly, +// Charles Mesztenyi, John Rice, Henry Thatcher, +// Christoph Witzgall, +// Computer Approximations, +// Wiley, 1968, +// LC: QA297.C64. +// +// Parameters: +// +// Input, double X, the argument of the function. +// +// Output, double R8_GAMMA, the value of the function. +// +{ +// +// Coefficients for minimax approximation over (12, INF). +// + double c[7] = { + -1.910444077728E-03, + 8.4171387781295E-04, + -5.952379913043012E-04, + 7.93650793500350248E-04, + -2.777777777777681622553E-03, + 8.333333333333333331554247E-02, + 5.7083835261E-03 }; + double eps = 2.22E-16; + double fact; + int i; + int n; + double one = 1.0; + double p[8] = { + -1.71618513886549492533811E+00, + 2.47656508055759199108314E+01, + -3.79804256470945635097577E+02, + 6.29331155312818442661052E+02, + 8.66966202790413211295064E+02, + -3.14512729688483675254357E+04, + -3.61444134186911729807069E+04, + 6.64561438202405440627855E+04 }; + bool parity; + double pi = 3.1415926535897932384626434; + double q[8] = { + -3.08402300119738975254353E+01, + 3.15350626979604161529144E+02, + -1.01515636749021914166146E+03, + -3.10777167157231109440444E+03, + 2.25381184209801510330112E+04, + 4.75584627752788110767815E+03, + -1.34659959864969306392456E+05, + -1.15132259675553483497211E+05 }; + double res; + double sqrtpi = 0.9189385332046727417803297; + double sum; + double twelve = 12.0; + double two = 2.0; + double value; + double xbig = 171.624; + double xden; + double xinf = 1.79E+308; + double xminin = 2.23E-308; + double xnum; + double y; + double y1; + double ysq; + double z; + + parity = false; + fact = one; + n = 0; + y = x; +// +// Argument is negative. +// + if ( y <= 0.0 ) + { + y = - x; + y1 = ( double ) ( int ) ( y ); + res = y - y1; + + if ( res != 0.0 ) + { + if ( y1 != ( double ) ( int ) ( y1 * 0.5 ) * two ) + { + parity = true; + } + + fact = - pi / std::sin ( pi * res ); + y = y + one; + } + else + { + res = xinf; + value = res; + return value; + } + } +// +// Argument is positive. +// + if ( y < eps ) + { +// +// Argument < EPS. +// + if ( xminin <= y ) + { + res = one / y; + } + else + { + res = xinf; + value = res; + return value; + } + } + else if ( y < twelve ) + { + y1 = y; +// +// 0.0 < argument < 1.0. +// + if ( y < one ) + { + z = y; + y = y + one; + } +// +// 1.0 < argument < 12.0. +// Reduce argument if necessary. +// + else + { + n = ( int ) ( y ) - 1; + y = y - ( double ) ( n ); + z = y - one; + } +// +// Evaluate approximation for 1.0 < argument < 2.0. +// + xnum = 0.0; + xden = one; + for ( i = 0; i < 8; i++ ) + { + xnum = ( xnum + p[i] ) * z; + xden = xden * z + q[i]; + } + res = xnum / xden + one; +// +// Adjust result for case 0.0 < argument < 1.0. +// + if ( y1 < y ) + { + res = res / y1; + } +// +// Adjust result for case 2.0 < argument < 12.0. +// + else if ( y < y1 ) + { + for ( i = 1; i <= n; i++ ) + { + res = res * y; + y = y + one; + } + } + } + else + { +// +// Evaluate for 12.0 <= argument. +// + if ( y <= xbig ) + { + ysq = y * y; + sum = c[6]; + for ( i = 0; i < 6; i++ ) + { + sum = sum / ysq + c[i]; + } + sum = sum / y - y + sqrtpi; + sum = sum + ( y - 0.5 ) * std::log ( y ); + res = std::exp ( sum ); + } + else + { + res = xinf; + value = res; + return value; + } + } +// +// Final adjustments and return. +// + if ( parity ) + { + res = - res; + } + + if ( fact != one ) + { + res = fact / res; + } + + value = res; + + return value; +} +//****************************************************************************80 + +double r8_huge ( ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_HUGE returns a "huge" R8. +// +// Discussion: +// +// The value returned by this function is NOT required to be the +// maximum representable R8. This value varies from machine to machine, +// from compiler to compiler, and may cause problems when being printed. +// We simply want a "very large" but non-infinite number. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 06 October 2007 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Output, double R8_HUGE, a "huge" R8 value. +// +{ + double value; + + value = 1.0E+30; + + return value; +} +//****************************************************************************80 + +double r8_hyper_2f1 ( double a, double b, double c, double x ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_HYPER_2F1 evaluates the hypergeometric function 2F1(A,B,C,X). +// +// Discussion: +// +// A bug was corrected. A line which read +// c1 = - ( - 1.0, m ) * gc / ( gam * gbm * rm ); +// was corrected to read +// c1 = - std::pow ( - 1.0, m ) * gc / ( gam * gbm * rm ); +// JVB, 05 July 2009. +// +// A minor bug was corrected. The HW variable, used in several places as +// the "old" value of a quantity being iteratively improved, was not +// being initialized. JVB, 11 February 2008. +// +// The FORTRAN77 original version of this routine is copyrighted by +// Shanjie Zhang and Jianming Jin. However, they give permission to +// incorporate this routine into a user program provided that the copyright +// is acknowledged. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 05 July 2009 +// +// Author: +// +// Original FORTRAN77 version by Shanjie Zhang, Jianming Jin. +// C++ version by John Burkardt. +// +// Reference: +// +// Shanjie Zhang, Jianming Jin, +// Computation of Special Functions, +// Wiley, 1996, +// ISBN: 0-471-11963-6, +// LC: QA351.C45 +// +// Parameters: +// +// Input, double A, B, C, X, the arguments of the function. +// C must not be equal to a nonpositive integer. +// X < 1. +// +// Output, double R8_HYPER_2F1, the value of the function. +// +{ + double a0; + double aa; + double bb; + double c0; + double c1; + double el = 0.5772156649015329; + double eps; + double f0; + double f1; + double g0; + double g1; + double g2; + double g3; + double ga; + double gabc; + double gam; + double gb; + double gbm; + double gc; + double gca; + double gcab; + double gcb; + double gm; + double hf; + double hw; + int j; + int k; + bool l0; + bool l1; + bool l2; + bool l3; + bool l4; + bool l5; + int m; + int nm; + double pa; + double pb; + double pi = 3.141592653589793; + double r; + double r0; + double r1; + double rm; + double rp; + double sm; + double sp; + double sp0; + double x1; + + l0 = ( c == ( int ) ( c ) ) && ( c < 0.0 ); + l1 = ( 1.0 - x < 1.0E-15 ) && ( c - a - b <= 0.0 ); + l2 = ( a == ( int ) ( a ) ) && ( a < 0.0 ); + l3 = ( b == ( int ) ( b ) ) && ( b < 0.0 ); + l4 = ( c - a == ( int ) ( c - a ) ) && ( c - a <= 0.0 ); + l5 = ( c - b == ( int ) ( c - b ) ) && ( c - b <= 0.0 ); + + if ( l0 ) + { + std::cerr << "\n"; + std::cerr << "R8_HYPER_2F1 - Fatal error!\n"; + std::cerr << " The hypergeometric series is divergent.\n"; + std::cerr << " C is integral and negative.\n"; + std::cerr << " C = " << c << "\n"; + std::exit ( 1 ); + } + + if ( l1 ) + { + std::cerr << "\n"; + std::cerr << "R8_HYPER_2F1 - Fatal error!\n"; + std::cerr << " The hypergeometric series is divergent.\n"; + std::cerr << " 1 - X < 0, C - A - B <= 0\n"; + std::cerr << " A = " << a << "\n"; + std::cerr << " B = " << b << "\n"; + std::cerr << " C = " << c << "\n"; + std::cerr << " X = " << x << "\n"; + std::exit ( 1 ); + } + + if ( 0.95 < x ) + { + eps = 1.0E-08; + } + else + { + eps = 1.0E-15; + } + + if ( x == 0.0 || a == 0.0 || b == 0.0 ) + { + hf = 1.0; + return hf; + } + else if ( 1.0 - x == eps && 0.0 < c - a - b ) + { + gc = webbur::r8_gamma ( c ); + gcab = webbur::r8_gamma ( c - a - b ); + gca = webbur::r8_gamma ( c - a ); + gcb = webbur::r8_gamma ( c - b ); + hf = gc * gcab / ( gca * gcb ); + return hf; + } + else if ( 1.0 + x <= eps && r8_abs ( c - a + b - 1.0 ) <= eps ) + { + g0 = std::sqrt ( pi ) * std::pow ( 2.0, - a ); + g1 = webbur::r8_gamma ( c ); + g2 = webbur::r8_gamma ( 1.0 + a / 2.0 - b ); + g3 = webbur::r8_gamma ( 0.5 + 0.5 * a ); + hf = g0 * g1 / ( g2 * g3 ); + return hf; + } + else if ( l2 || l3 ) + { + if ( l2 ) + { + nm = ( int ) ( webbur::r8_abs ( a ) ); + } + + if ( l3 ) + { + nm = ( int ) ( webbur::r8_abs ( b ) ); + } + + hf = 1.0; + r = 1.0; + + for ( k = 1; k <= nm; k++ ) + { + r = r * ( a + k - 1.0 ) * ( b + k - 1.0 ) + / ( k * ( c + k - 1.0 ) ) * x; + hf = hf + r; + } + + return hf; + } + else if ( l4 || l5 ) + { + if ( l4 ) + { + nm = ( int ) ( webbur::r8_abs ( c - a ) ); + } + + if ( l5 ) + { + nm = ( int ) ( webbur::r8_abs ( c - b ) ); + } + + hf = 1.0; + r = 1.0; + for ( k = 1; k <= nm; k++ ) + { + r = r * ( c - a + k - 1.0 ) * ( c - b + k - 1.0 ) + / ( k * ( c + k - 1.0 ) ) * x; + hf = hf + r; + } + hf = std::pow ( 1.0 - x, c - a - b ) * hf; + return hf; + } + + aa = a; + bb = b; + x1 = x; + + if ( x < 0.0 ) + { + x = x / ( x - 1.0 ); + if ( a < c && b < a && 0.0 < b ) + { + a = bb; + b = aa; + } + b = c - b; + } + + if ( 0.75 <= x ) + { + gm = 0.0; + + if ( webbur::r8_abs ( c - a - b - ( int ) ( c - a - b ) ) < 1.0E-15 ) + { + m = ( int ) ( c - a - b ); + ga = webbur::r8_gamma ( a ); + gb = webbur::r8_gamma ( b ); + gc = webbur::r8_gamma ( c ); + gam = webbur::r8_gamma ( a + m ); + gbm = webbur::r8_gamma ( b + m ); + + pa = webbur::r8_psi ( a ); + pb = webbur::r8_psi ( b ); + + if ( m != 0 ) + { + gm = 1.0; + } + + for ( j = 1; j <= std::abs ( m ) - 1; j++ ) + { + gm = gm * j; + } + + rm = 1.0; + for ( j = 1; j <= std::abs ( m ); j++ ) + { + rm = rm * j; + } + + f0 = 1.0; + r0 = 1.0;; + r1 = 1.0; + sp0 = 0.0;; + sp = 0.0; + + if ( 0 <= m ) + { + c0 = gm * gc / ( gam * gbm ); + c1 = - gc * std::pow ( x - 1.0, m ) / ( ga * gb * rm ); + + for ( k = 1; k <= m - 1; k++ ) + { + r0 = r0 * ( a + k - 1.0 ) * ( b + k - 1.0 ) + / ( k * ( k - m ) ) * ( 1.0 - x ); + f0 = f0 + r0; + } + + for ( k = 1; k <= m; k++ ) + { + sp0 = sp0 + 1.0 / ( a + k - 1.0 ) + 1.0 / ( b + k - 1.0 ) + - 1.0 / ( double ) ( k ); + } + + f1 = pa + pb + sp0 + 2.0 * el + std::log ( 1.0 - x ); + hw = f1; + + for ( k = 1; k <= 250; k++ ) + { + sp = sp + ( 1.0 - a ) / ( k * ( a + k - 1.0 ) ) + + ( 1.0 - b ) / ( k * ( b + k - 1.0 ) ); + + sm = 0.0; + for ( j = 1; j <= m; j++ ) + { + sm = sm + ( 1.0 - a ) + / ( ( j + k ) * ( a + j + k - 1.0 ) ) + + 1.0 / ( b + j + k - 1.0 ); + } + + rp = pa + pb + 2.0 * el + sp + sm + std::log ( 1.0 - x ); + + r1 = r1 * ( a + m + k - 1.0 ) * ( b + m + k - 1.0 ) + / ( k * ( m + k ) ) * ( 1.0 - x ); + + f1 = f1 + r1 * rp; + + if ( r8_abs ( f1 - hw ) < r8_abs ( f1 ) * eps ) + { + break; + } + hw = f1; + } + hf = f0 * c0 + f1 * c1; + } + else if ( m < 0 ) + { + m = - m; + c0 = gm * gc / ( ga * gb * std::pow ( 1.0 - x, m ) ); + c1 = - std::pow ( - 1.0, m ) * gc / ( gam * gbm * rm ); + + for ( k = 1; k <= m - 1; k++ ) + { + r0 = r0 * ( a - m + k - 1.0 ) * ( b - m + k - 1.0 ) + / ( k * ( k - m ) ) * ( 1.0 - x ); + f0 = f0 + r0; + } + + for ( k = 1; k <= m; k++ ) + { + sp0 = sp0 + 1.0 / ( double ) ( k ); + } + + f1 = pa + pb - sp0 + 2.0 * el + std::log ( 1.0 - x ); + hw = f1; + + for ( k = 1; k <= 250; k++ ) + { + sp = sp + ( 1.0 - a ) + / ( k * ( a + k - 1.0 ) ) + + ( 1.0 - b ) / ( k * ( b + k - 1.0 ) ); + + sm = 0.0; + for ( j = 1; j <= m; j++ ) + { + sm = sm + 1.0 / ( double ) ( j + k ); + } + + rp = pa + pb + 2.0 * el + sp - sm + std::log ( 1.0 - x ); + + r1 = r1 * ( a + k - 1.0 ) * ( b + k - 1.0 ) + / ( k * ( m + k ) ) * ( 1.0 - x ); + + f1 = f1 + r1 * rp; + + if ( webbur::r8_abs ( f1 - hw ) < webbur::r8_abs ( f1 ) * eps ) + { + break; + } + + hw = f1; + } + + hf = f0 * c0 + f1 * c1; + } + } + else + { + ga = webbur::r8_gamma ( a ); + gb = webbur::r8_gamma ( b ); + gc = webbur::r8_gamma ( c ); + gca = webbur::r8_gamma ( c - a ); + gcb = webbur::r8_gamma ( c - b ); + gcab = webbur::r8_gamma ( c - a - b ); + gabc = webbur::r8_gamma ( a + b - c ); + c0 = gc * gcab / ( gca * gcb ); + c1 = gc * gabc / ( ga * gb ) * std::pow ( 1.0 - x, c - a - b ); + hf = 0.0; + hw = hf; + r0 = c0; + r1 = c1; + + for ( k = 1; k <= 250; k++ ) + { + r0 = r0 * ( a + k - 1.0 ) * ( b + k - 1.0 ) + / ( k * ( a + b - c + k ) ) * ( 1.0 - x ); + + r1 = r1 * ( c - a + k - 1.0 ) * ( c - b + k - 1.0 ) + / ( k * ( c - a - b + k ) ) * ( 1.0 - x ); + + hf = hf + r0 + r1; + + if ( webbur::r8_abs ( hf - hw ) < webbur::r8_abs ( hf ) * eps ) + { + break; + } + hw = hf; + } + hf = hf + c0 + c1; + } + } + else + { + a0 = 1.0; + + if ( a < c && c < 2.0 * a && b < c && c < 2.0 * b ) + { + a0 = std::pow ( 1.0 - x, c - a - b ); + a = c - a; + b = c - b; + } + + hf = 1.0; + hw = hf; + r = 1.0; + + for ( k = 1; k <= 250; k++ ) + { + r = r * ( a + k - 1.0 ) * ( b + k - 1.0 ) + / ( k * ( c + k - 1.0 ) ) * x; + + hf = hf + r; + + if ( webbur::r8_abs ( hf - hw ) <= webbur::r8_abs ( hf ) * eps ) + { + break; + } + + hw = hf; + } + hf = a0 * hf; + } + + if ( x1 < 0.0 ) + { + x = x1; + c0 = 1.0 / std::pow ( 1.0 - x, aa ); + hf = c0 * hf; + } + + a = aa; + b = bb; + + if ( 120 < k ) + { + std::cerr << "\n"; + std::cerr << "R8_HYPER_2F1 - Warning!\n"; + std::cerr << " A large number of iterations were needed.\n"; + std::cerr << " The accuracy of the results should be checked.\n"; + } + + return hf; +} +//****************************************************************************80 + +double r8_max ( double x, double y ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_MAX returns the maximum of two R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 August 2004 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, double X, Y, the quantities to compare. +// +// Output, double R8_MAX, the maximum of X and Y. +// +{ + double value; + + if ( y < x ) + { + value = x; + } + else + { + value = y; + } + return value; +} +//****************************************************************************80 + +double r8_min ( double x, double y ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_MIN returns the minimum of two R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 31 August 2004 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, double X, Y, the quantities to compare. +// +// Output, double R8_MIN, the minimum of X and Y. +// +{ + double value; + + if ( y < x ) + { + value = y; + } + else + { + value = x; + } + return value; +} +//****************************************************************************80 + +double r8_mop ( int i ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_MOP returns the I-th power of -1 as an R8 value. +// +// Discussion: +// +// An R8 is an double value. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 16 November 2007 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int I, the power of -1. +// +// Output, double R8_MOP, the I-th power of -1. +// +{ + double value; + + if ( ( i % 2 ) == 0 ) + { + value = 1.0; + } + else + { + value = -1.0; + } + + return value; +} +//****************************************************************************80 + +double r8_psi ( double xx ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_PSI evaluates the function Psi(X). +// +// Discussion: +// +// This routine evaluates the logarithmic derivative of the +// Gamma function, +// +// PSI(X) = d/dX ( GAMMA(X) ) / GAMMA(X) +// = d/dX LN ( GAMMA(X) ) +// +// for real X, where either +// +// - XMAX1 < X < - XMIN, and X is not a negative integer, +// +// or +// +// XMIN < X. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 09 February 2008 +// +// Author: +// +// Original FORTRAN77 version by William Cody. +// C++ version by John Burkardt. +// +// Reference: +// +// William Cody, Anthony Strecok, Henry Thacher, +// Chebyshev Approximations for the Psi Function, +// Mathematics of Computation, +// Volume 27, Number 121, January 1973, pages 123-127. +// +// Parameters: +// +// Input, double XX, the argument of the function. +// +// Output, double R8_PSI, the value of the function. +// +{ + double aug; + double den; + int i; + int n; + int nq; + double one = 1.0; + double p1[9] = { + 4.5104681245762934160E-03, + 5.4932855833000385356, + 3.7646693175929276856E+02, + 7.9525490849151998065E+03, + 7.1451595818951933210E+04, + 3.0655976301987365674E+05, + 6.3606997788964458797E+05, + 5.8041312783537569993E+05, + 1.6585695029761022321E+05 }; + double p2[7] = { + -2.7103228277757834192, + -1.5166271776896121383E+01, + -1.9784554148719218667E+01, + -8.8100958828312219821, + -1.4479614616899842986, + -7.3689600332394549911E-02, + -6.5135387732718171306E-21 }; + double piov4 = 0.78539816339744830962; + double q1[8] = { + 9.6141654774222358525E+01, + 2.6287715790581193330E+03, + 2.9862497022250277920E+04, + 1.6206566091533671639E+05, + 4.3487880712768329037E+05, + 5.4256384537269993733E+05, + 2.4242185002017985252E+05, + 6.4155223783576225996E-08 }; + double q2[6] = { + 4.4992760373789365846E+01, + 2.0240955312679931159E+02, + 2.4736979003315290057E+02, + 1.0742543875702278326E+02, + 1.7463965060678569906E+01, + 8.8427520398873480342E-01 }; + double sgn; + double three = 3.0; + double upper; + double value; + double w; + double x; + double x01 = 187.0; + double x01d = 128.0; + double x02 = 6.9464496836234126266E-04; + double xinf = 1.70E+38; + double xlarge = 2.04E+15; + double xmax1 = 3.60E+16; + double xmin1 = 5.89E-39; + double xsmall = 2.05E-09; + double z; + + x = xx; + w = webbur::r8_abs ( x ); + aug = 0.0; +// +// Check for valid arguments, then branch to appropriate algorithm. +// + if ( xmax1 <= - x || w < xmin1 ) + { + if ( 0.0 < x ) + { + value = - xinf; + } + else + { + value = xinf; + } + return value; + } + + if ( x < 0.5 ) + { +// +// X < 0.5, use reflection formula: psi(1-x) = psi(x) + pi * cot(pi*x) +// Use 1/X for PI*COTAN(PI*X) when XMIN1 < |X| <= XSMALL. +// + if ( w <= xsmall ) + { + aug = - one / x; + } +// +// Argument reduction for cotangent. +// + else + { + if ( x < 0.0 ) + { + sgn = piov4; + } + else + { + sgn = - piov4; + } + + w = w - ( double ) ( ( int ) ( w ) ); + nq = ( int ) ( w * 4.0 ); + w = 4.0 * ( w - ( double ) ( nq ) * 0.25 ); +// +// W is now related to the fractional part of 4.0 * X. +// Adjust argument to correspond to values in the first +// quadrant and determine the sign. +// + n = nq / 2; + + if ( n + n != nq ) + { + w = one - w; + } + + z = piov4 * w; + + if ( ( n % 2 ) != 0 ) + { + sgn = - sgn; + } +// +// Determine the final value for -pi * cotan(pi*x). +// + n = ( nq + 1 ) / 2; + if ( ( n % 2 ) == 0 ) + { +// +// Check for singularity. +// + if ( z == 0.0 ) + { + if ( 0.0 < x ) + { + value = -xinf; + } + else + { + value = xinf; + } + return value; + } + aug = sgn * ( 4.0 / std::tan ( z ) ); + } + else + { + aug = sgn * ( 4.0 * std::tan ( z ) ); + } + } + x = one - x; + } +// +// 0.5 <= X <= 3.0. +// + if ( x <= three ) + { + den = x; + upper = p1[0] * x; + for ( i = 1; i <= 7; i++ ) + { + den = ( den + q1[i-1] ) * x; + upper = ( upper + p1[i]) * x; + } + den = ( upper + p1[8] ) / ( den + q1[7] ); + x = ( x - x01 / x01d ) - x02; + value = den * x + aug; + return value; + } +// +// 3.0 < X. +// + if ( x < xlarge ) + { + w = one / ( x * x ); + den = w; + upper = p2[0] * w; + for ( i = 1; i <= 5; i++ ) + { + den = ( den + q2[i-1] ) * w; + upper = ( upper + p2[i] ) * w; + } + aug = ( upper + p2[6] ) / ( den + q2[5] ) - 0.5 / x + aug; + } + + value = aug + std::log ( x ); + + return value; +} +//****************************************************************************80 + +double r8_sign ( double x ) + +//****************************************************************************80 +// +// Purpose: +// +// R8_SIGN returns the sign of an R8. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 October 2004 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, double X, the number whose sign is desired. +// +// Output, double R8_SIGN, the sign of X. +// +{ + double value; + + if ( x < 0.0 ) + { + value = -1.0; + } + else + { + value = 1.0; + } + return value; +} +//****************************************************************************80 + +int r8col_compare ( int m, int n, double a[], int i, int j ) + +//****************************************************************************80 +// +// Purpose: +// +// R8COL_COMPARE compares two columns in an R8COL. +// +// Discussion: +// +// An R8COL is an M by N array of R8's, regarded as an array of N columns, +// each of length M. +// +// Example: +// +// Input: +// +// M = 3, N = 4, I = 2, J = 4 +// +// A = ( +// 1. 2. 3. 4. +// 5. 6. 7. 8. +// 9. 10. 11. 12. ) +// +// Output: +// +// R8COL_COMPARE = -1 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 13 September 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns. +// +// Input, double A[M*N], the M by N array. +// +// Input, int I, J, the columns to be compared. +// I and J must be between 1 and N. +// +// Output, int R8COL_COMPARE, the results of the comparison: +// -1, column I < column J, +// 0, column I = column J, +// +1, column J < column I. +// +{ + int k; + int value; +// +// Check. +// + if ( i < 1 || n < i ) + { + std::cerr << "\n"; + std::cerr << "R8COL_COMPARE - Fatal error!\n"; + std::cerr << " Column index I is out of bounds.\n"; + std::cerr << " I = " << i << "\n"; + std::exit ( 1 ); + } + + if ( j < 1 || n < j ) + { + std::cerr << "\n"; + std::cerr << "R8COL_COMPARE - Fatal error!\n"; + std::cerr << " Column index J is out of bounds.\n"; + std::cerr << " J = " << j << "\n"; + std::exit ( 1 ); + } + + value = 0; + + if ( i == j ) + { + return value; + } + + k = 0; + + while ( k < m ) + { + if ( a[k+(i-1)*m] < a[k+(j-1)*m] ) + { + value = -1; + return value; + } + else if ( a[k+(j-1)*m] < a[k+(i-1)*m] ) + { + value = +1; + return value; + } + k = k + 1; + } + + return value; +} +//****************************************************************************80 + +void r8col_sort_heap_a ( int m, int n, double a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8COL_SORT_HEAP_A ascending heapsorts an R8COL. +// +// Discussion: +// +// An R8COL is an M by N array of R8's, regarded as an array of N columns, +// each of length M. +// +// In lexicographic order, the statement "X < Y", applied to two real +// vectors X and Y of length M, means that there is some index I, with +// 1 <= I <= M, with the property that +// +// X(J) = Y(J) for J < I, +// and +// X(I) < Y(I). +// +// In other words, the first time they differ, X is smaller. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 15 September 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns. +// +// Input/output, double A[M*N]. +// On input, the array of N columns of M-vectors. +// On output, the columns of A have been sorted in lexicographic order. +// +{ + int i; + int indx; + int isgn; + int j; + + if ( m <= 0 ) + { + return; + } + + if ( n <= 1 ) + { + return; + } +// +// Initialize. +// + i = 0; + indx = 0; + isgn = 0; + j = 0; +// +// Call the external heap sorter. +// + for ( ; ; ) + { + webbur::sort_heap_external ( n, &indx, &i, &j, isgn ); +// +// Interchange the I and J objects. +// + if ( 0 < indx ) + { + webbur::r8col_swap ( m, n, a, i, j ); + } +// +// Compare the I and J objects. +// + else if ( indx < 0 ) + { + isgn = webbur::r8col_compare ( m, n, a, i, j ); + } + else if ( indx == 0 ) + { + break; + } + } + + return; +} +//****************************************************************************80 + +int *r8col_sort_heap_index_a ( int m, int n, double a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8COL_SORT_HEAP_INDEX_A does an indexed heap ascending sort of an R8COL. +// +// Discussion: +// +// An R8COL is an M by N array of R8's, regarded as an array of N columns, +// each of length M. +// +// The sorting is not actually carried out. Rather an index array is +// created which defines the sorting. This array may be used to sort +// or index the array, or to sort or index related arrays keyed on the +// original array. +// +// A(*,J1) < A(*,J2) if the first nonzero entry of A(*,J1)-A(*,J2) +// is negative. +// +// Once the index array is computed, the sorting can be carried out +// "implicitly: +// +// A(*,INDX(*)) is sorted, +// +// Note that the index vector is 0-based. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 01 November 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the number of rows in each column of A. +// +// Input, int N, the number of columns in A. +// +// Input, double A[M*N], the array. +// +// Output, int R8COL_SORT_HEAP_INDEX_A[N], contains the sort index. The +// I-th column of the sorted array is A(*,INDX(I)). +// +{ + double *column; + int i; + int *indx; + int indxt; + int ir; + int isgn; + int j; + int k; + int l; + + if ( n < 1 ) + { + return NULL; + } + + indx = new int[n]; + + for ( i = 0; i < n; i++ ) + { + indx[i] = i; + } + + if ( n == 1 ) + { + return indx; + } + + column = new double[m]; + + l = n / 2 + 1; + ir = n; + + for ( ; ; ) + { + if ( 1 < l ) + { + l = l - 1; + indxt = indx[l-1]; + for ( k = 0; k < m; k++ ) + { + column[k] = a[k+indxt*m]; + } + } + else + { + indxt = indx[ir-1]; + for ( k = 0; k < m; k++ ) + { + column[k] = a[k+indxt*m]; + } + indx[ir-1] = indx[0]; + ir = ir - 1; + + if ( ir == 1 ) + { + indx[0] = indxt; + break; + } + } + + i = l; + j = l + l; + + while ( j <= ir ) + { + if ( j < ir ) + { + isgn = webbur::r8vec_compare ( m, a+indx[j-1]*m, a+indx[j]*m ); + + if ( isgn < 0 ) + { + j = j + 1; + } + } + + isgn = webbur::r8vec_compare ( m, column, a+indx[j-1]*m ); + + if ( isgn < 0 ) + { + indx[i-1] = indx[j-1]; + i = j; + j = j + j; + } + else + { + j = ir + 1; + } + } + indx[i-1] = indxt; + } + delete [] column; + + return indx; +} +//****************************************************************************80 + +int r8col_sorted_unique_count ( int m, int n, double a[], double tol ) + +//****************************************************************************80 +// +// Purpose: +// +// R8COL_SORTED_UNIQUE_COUNT counts unique elements in a sorted R8COL. +// +// Discussion: +// +// An R8COL is an M by N array of R8's, regarded as an array of N columns, +// each of length M. +// +// The columns of the array may be ascending or descending sorted. +// +// If the tolerance is large enough, then the concept of uniqueness +// can become ambiguous. If we have a tolerance of 1.5, then in the +// list ( 1, 2, 3, 4, 5, 6, 7, 8, 9 ) is it fair to say we have only +// one unique entry? That would be because 1 may be regarded as unique, +// and then 2 is too close to 1 to be unique, and 3 is too close to 2 to +// be unique and so on. +// +// This seems wrongheaded. So I prefer the idea that an item is not +// unique under a tolerance only if it is close to something that IS unique. +// Thus, the unique items are guaranteed to cover the space if we include +// a disk of radius TOL around each one. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 01 November 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns. +// +// Input, double A[M*N], a sorted array, containing +// N columns of data. +// +// Input, double TOL, a tolerance for equality. +// +// Output, int R8COL_SORTED_UNIQUE_COUNT, the number of unique columns. +// +{ + double diff; + int i; + int j1; + int j2; + int unique_num; + + unique_num = 0; + + if ( n <= 0 ) + { + return unique_num; + } + + unique_num = 1; + j1 = 0; + + for ( j2 = 1; j2 < n; j2++ ) + { + diff = 0.0; + for ( i = 0; i < m; i++ ) + { + diff = webbur::r8_max ( diff, webbur::r8_abs ( a[i+j1*m] - a[i+j2*m] ) ); + } + if ( tol < diff ) + { + unique_num = unique_num + 1; + j1 = j2; + } + } + + return unique_num; +} +//****************************************************************************80 + +void r8col_swap ( int m, int n, double a[], int j1, int j2 ) + +//****************************************************************************80 +// +// Purpose: +// +// R8COL_SWAP swaps columns J1 and J2 of an R8COL. +// +// Discussion: +// +// An R8COL is an M by N array of R8's, regarded as an array of N columns, +// each of length M. +// +// Example: +// +// Input: +// +// M = 3, N = 4, J1 = 2, J2 = 4 +// +// A = ( +// 1. 2. 3. 4. +// 5. 6. 7. 8. +// 9. 10. 11. 12. ) +// +// Output: +// +// A = ( +// 1. 4. 3. 2. +// 5. 8. 7. 6. +// 9. 12. 11. 10. ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 October 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns. +// +// Input/output, double A[M*N], the M by N array. +// +// Input, int J1, J2, the columns to be swapped. +// These columns are 1-based. +// +{ + int i; + double temp; + + if ( j1 < 1 || n < j1 || j2 < 1 || n < j2 ) + { + std::cerr << "\n"; + std::cerr << "R8COL_SWAP - Fatal error!\n"; + std::cerr << " J1 or J2 is out of bounds.\n"; + std::cerr << " J1 = " << j1 << "\n"; + std::cerr << " J2 = " << j2 << "\n"; + std::cerr << " NCOL = " << n << "\n"; + std::exit ( 1 ); + } + + if ( j1 == j2 ) + { + return; + } + + for ( i = 0; i < m; i++ ) + { + temp = a[i+(j1-1)*m]; + a[i+(j1-1)*m] = a[i+(j2-1)*m]; + a[i+(j2-1)*m] = temp; + } + + return; +} +//****************************************************************************80 + +void r8col_tol_undex ( int m, int n, double a[], int unique_num, double tol, + int undx[], int xdnu[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8COL_TOL_UNDEX indexes tolerably unique entries of an R8COL. +// +// Discussion: +// +// An R8COL is an M by N array of R8's, regarded as an array of N columns, +// each of length M. +// +// The goal of this routine is to determine a vector UNDX, +// which points to the unique elements of A, in sorted order, +// and a vector XDNU, which identifies, for each entry of A, the index of +// the unique sorted element of A. +// +// This is all done with index vectors, so that the elements of +// A are never moved. +// +// The first step of the algorithm requires the indexed sorting +// of A, which creates arrays INDX and XDNI. (If all the entries +// of A are unique, then these arrays are the same as UNDX and XDNU.) +// +// We then use INDX to examine the entries of A in sorted order, +// noting the unique entries, creating the entries of XDNU and +// UNDX as we go. +// +// Once this process has been completed, the vector A could be +// replaced by a compressed vector XU, containing the unique entries +// of A in sorted order, using the formula +// +// XU(*) = A(UNDX(*)). +// +// We could then, if we wished, reconstruct the entire vector A, or +// any element of it, by index, as follows: +// +// A(I) = XU(XDNU(I)). +// +// We could then replace A by the combination of XU and XDNU. +// +// Later, when we need the I-th entry of A, we can locate it as +// the XDNU(I)-th entry of XU. +// +// Here is an example of a vector A, the sort and inverse sort +// index vectors, and the unique sort and inverse unique sort vectors +// and the compressed unique sorted vector. +// +// I A Indx Xdni XU Undx Xdnu +// ----+-----+-----+-----+--------+-----+-----+ +// 0 | 11. 0 0 | 11. 0 0 +// 1 | 22. 2 4 | 22. 1 1 +// 2 | 11. 5 1 | 33. 3 0 +// 3 | 33. 8 7 | 55. 4 2 +// 4 | 55. 1 8 | 3 +// 5 | 11. 6 2 | 0 +// 6 | 22. 7 5 | 1 +// 7 | 22. 3 6 | 1 +// 8 | 11. 4 3 | 0 +// +// INDX(2) = 3 means that sorted item(2) is A(3). +// XDNI(2) = 5 means that A(2) is sorted item(5). +// +// UNDX(3) = 4 means that unique sorted item(3) is at A(4). +// XDNU(8) = 2 means that A(8) is at unique sorted item(2). +// +// XU(XDNU(I))) = X(I). +// XU(I) = X(UNDX(I)). +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 July 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, the dimension of the data values. +// +// Input, int N, the number of data values, +// +// Input, double A[M*N], the data values. +// +// Input, int UNIQUE_NUM, the number of unique values in A. +// This value is only required for languages in which the size of +// UNDX must be known in advance. +// +// Input, double TOL, a tolerance for equality. +// +// Output, int UNDX[UNIQUE_NUM], the UNDX vector. +// +// Output, int XDNU[N], the XDNU vector. +// +{ + double diff; + int i; + int i2; + int *indx; + int j; + int k; + bool unique; +// +// Implicitly sort the array. +// + indx = webbur::r8col_sort_heap_index_a ( m, n, a ); +// +// Consider entry I = 0. +// It is unique, so set the number of unique items to K. +// Set the K-th unique item to I. +// Set the representative of item I to the K-th unique item. +// + i = 0; + k = 0; + undx[k] = indx[i]; + xdnu[indx[i]] = k; +// +// Consider entry I. +// +// If it is unique, increase the unique count K, set the +// K-th unique item to I, and set the representative of I to K. +// +// If it is not unique, set the representative of item I to a +// previously determined unique item that is close to it. +// + for ( i = 1; i < n; i++ ) + { + unique = true; + for ( j = 0; j <= k; j++ ) + { + diff = 0.0; + for ( i2 = 0; i2 < m; i2++ ) + { + diff = webbur::r8_max ( diff, + webbur::r8_abs ( a[i2+indx[i]*m] - a[i2+undx[j]*m] ) ); + } + if ( diff <= tol ) + { + unique = false; + xdnu[indx[i]] = j; + break; + } + } + if ( unique ) + { + k = k + 1; + undx[k] = indx[i]; + xdnu[indx[i]] = k; + } + } + delete [] indx; + + return; +} +//****************************************************************************80 + +int r8col_tol_unique_count ( int m, int n, double a[], double tol ) + +//****************************************************************************80 +// +// Purpose: +// +// R8COL_TOL_UNIQUE_COUNT counts tolerably unique entries in an R8COL. +// +// Discussion: +// +// An R8COL is an M by N array of R8's, regarded as an array of N columns, +// each of length M. +// +// The columns of the array may be ascending or descending sorted. +// +// If the tolerance is large enough, then the concept of uniqueness +// can become ambiguous. If we have a tolerance of 1.5, then in the +// list ( 1, 2, 3, 4, 5, 6, 7, 8, 9 ) is it fair to say we have only +// one unique entry? That would be because 1 may be regarded as unique, +// and then 2 is too close to 1 to be unique, and 3 is too close to 2 to +// be unique and so on. +// +// This seems wrongheaded. So I prefer the idea that an item is not +// unique under a tolerance only if it is close to something that IS unique. +// Thus, the unique items are guaranteed to cover the space if we include +// a disk of radius TOL around each one. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 July 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns. +// +// Input, double A[M*N], the array of N columns of data. +// +// Input, double TOL, a tolerance for equality. +// +// Output, int R8COL_TOL_UNIQUE_COUNT, the number of unique columns. +// +{ + double diff; + int i; + int i2; + int *indx; + int j; + int k; + bool unique; + int *undx; + + undx = new int[n]; +// +// Implicitly sort the array. +// + indx = webbur::r8col_sort_heap_index_a ( m, n, a ); +// +// Consider entry I = 0. +// It is unique, so set the number of unique items to K. +// Set the K-th unique item to I. +// Set the representative of item I to the K-th unique item. +// + i = 0; + k = 0; + undx[k] = indx[i]; +// +// Consider entry I. +// +// If it is unique, increase the unique count K, set the +// K-th unique item to I, and set the representative of I to K. +// +// If it is not unique, set the representative of item I to a +// previously determined unique item that is close to it. +// + for ( i = 1; i < n; i++ ) + { + unique = true; + for ( j = 0; j <= k; j++ ) + { + diff = 0.0; + for ( i2 = 0; i2 < m; i2++ ) + { + diff = webbur::r8_max ( diff, + webbur::r8_abs ( a[i2+indx[i]*m] - a[i2+undx[j]*m] ) ); + } + if ( diff <= tol ) + { + unique = false; + break; + } + } + if ( unique ) + { + k = k + 1; + undx[k] = indx[i]; + } + } + delete [] indx; + delete [] undx; + + k = k + 1; + + return k; +} +//****************************************************************************80 + +void r8col_undex ( int x_dim, int x_num, double x_val[], int x_unique_num, + double tol, int undx[], int xdnu[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8COL_UNDEX returns unique sorted indexes for an R8COL. +// +// Discussion: +// +// An R8COL is an M by N array of R8's, regarded as an array of N columns, +// each of length M. +// +// The goal of this routine is to determine a vector UNDX, +// which points to the unique elements of X, in sorted order, +// and a vector XDNU, which identifies, for each entry of X, the index of +// the unique sorted element of X. +// +// This is all done with index vectors, so that the elements of +// X are never moved. +// +// The first step of the algorithm requires the indexed sorting +// of X, which creates arrays INDX and XDNI. (If all the entries +// of X are unique, then these arrays are the same as UNDX and XDNU.) +// +// We then use INDX to examine the entries of X in sorted order, +// noting the unique entries, creating the entries of XDNU and +// UNDX as we go. +// +// Once this process has been completed, the vector X could be +// replaced by a compressed vector XU, containing the unique entries +// of X in sorted order, using the formula +// +// XU(*) = X(UNDX(*)). +// +// We could then, if we wished, reconstruct the entire vector X, or +// any element of it, by index, as follows: +// +// X(I) = XU(XDNU(I)). +// +// We could then replace X by the combination of XU and XDNU. +// +// Later, when we need the I-th entry of X, we can locate it as +// the XDNU(I)-th entry of XU. +// +// Here is an example of a vector X, the sort and inverse sort +// index vectors, and the unique sort and inverse unique sort vectors +// and the compressed unique sorted vector. +// +// I X Indx Xdni XU Undx Xdnu +// ----+-----+-----+-----+--------+-----+-----+ +// 0 | 11. 0 0 | 11. 0 0 +// 1 | 22. 2 4 | 22. 1 1 +// 2 | 11. 5 1 | 33. 3 0 +// 3 | 33. 8 7 | 55. 4 2 +// 4 | 55. 1 8 | 3 +// 5 | 11. 6 2 | 0 +// 6 | 22. 7 5 | 1 +// 7 | 22. 3 6 | 1 +// 8 | 11. 4 3 | 0 +// +// INDX(2) = 3 means that sorted item(2) is X(3). +// XDNI(2) = 5 means that X(2) is sorted item(5). +// +// UNDX(3) = 4 means that unique sorted item(3) is at X(4). +// XDNU(8) = 2 means that X(8) is at unique sorted item(2). +// +// XU(XDNU(I))) = X(I). +// XU(I) = X(UNDX(I)). +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 02 November 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int X_DIM, the dimension of the data values. +// (the number of rows in the R8COL). +// +// Input, int X_NUM, the number of data values, +// (the number of columns in the R8COL). +// +// Input, double X_VAL[X_DIM*X_NUM], the data values. +// +// Input, int X_UNIQUE_NUM, the number of unique values in X_VAL. +// This value is only required for languages in which the size of +// UNDX must be known in advance. +// +// Input, double TOL, a tolerance for equality. +// +// Output, int UNDX[X_UNIQUE_NUM], the UNDX vector. +// +// Output, int XDNU[X_NUM], the XDNU vector. +// +{ + double diff; + int i; + int *indx; + int j; + int k; +// +// Implicitly sort the array. +// + indx = webbur::r8col_sort_heap_index_a ( x_dim, x_num, x_val ); +// +// Walk through the implicitly sorted array X. +// + i = 0; + + j = 0; + undx[j] = indx[i]; + + xdnu[indx[i]] = j; + + for ( i = 1; i < x_num; i++ ) + { + diff = 0.0; + for ( k = 0; k < x_dim; k++ ) + { + diff = r8_max ( diff, + webbur::r8_abs ( x_val[k+indx[i]*x_dim] - x_val[k+undx[j]*x_dim] ) ); + } + if ( tol < diff ) + { + j = j + 1; + undx[j] = indx[i]; + } + xdnu[indx[i]] = j; + } + delete [] indx; + + return; +} +//****************************************************************************80 + +void r8col_unique_index ( int m, int n, double a[], double tol, + int unique_index[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8COL_UNIQUE_INDEX indexes the first occurrence of values in an R8COL. +// +// Discussion: +// +// An R8COL is an M by N array of R8 values. +// It is regarded as an array of N columns of length M. +// +// For element A(1:M,J) of the matrix, UNIQUE_INDEX(J) is the uniqueness +// index of A(1:M,J). That is, if A_UNIQUE contains the unique elements +// of A, gathered in order, then +// +// A_UNIQUE ( 1:M, UNIQUE_INDEX(J) ) = A(1:M,J) +// +// The user must preallocate space for the output array UNIQUE_INDEX. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 24 November 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns of A. +// The length of an "element" of A, and the number of "elements". +// +// Input, double A[M*N], the array. +// +// Input, double TOL, a tolerance for equality. +// +// Output, int UNIQUE_INDEX[N], the unique index. +// +{ + double diff; + int i; + int j1; + int j2; + int unique_num; + + for ( j1 = 0; j1 < n; j1++ ) + { + unique_index[j1] = -1; + } + unique_num = 0; + + for ( j1 = 0; j1 < n; j1++ ) + { + if ( unique_index[j1] == -1 ) + { + unique_index[j1] = unique_num; + + for ( j2 = j1 + 1; j2 < n; j2++ ) + { + diff = 0.0; + for ( i = 0; i < m; i++ ) + { + diff = webbur::r8_max ( diff, + webbur::r8_abs ( a[i+j1*m] - a[i+j2*m] ) ); + } + if ( diff <= tol ) + { + unique_index[j2] = unique_num; + } + } + unique_num = unique_num + 1; + } + } + return; +} +//****************************************************************************80 + +void r8mat_transpose_print ( int m, int n, double a[], std::string title ) + +//****************************************************************************80 +// +// Purpose: +// +// R8MAT_TRANSPOSE_PRINT prints an R8MAT, transposed. +// +// Discussion: +// +// An R8MAT is a doubly dimensioned array of R8 values, stored as a vector +// in column-major order. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 10 September 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns. +// +// Input, double A[M*N], an M by N matrix to be printed. +// +// Input, string TITLE, a title. +// +{ + r8mat_transpose_print_some ( m, n, a, 1, 1, m, n, title ); + + return; +} +//****************************************************************************80 + +void r8mat_transpose_print_some ( int m, int n, double a[], int ilo, int jlo, + int ihi, int jhi, std::string title ) + +//****************************************************************************80 +// +// Purpose: +// +// R8MAT_TRANSPOSE_PRINT_SOME prints some of an R8MAT, transposed. +// +// Discussion: +// +// An R8MAT is a doubly dimensioned array of R8 values, stored as a vector +// in column-major order. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 10 September 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int M, N, the number of rows and columns. +// +// Input, double A[M*N], an M by N matrix to be printed. +// +// Input, int ILO, JLO, the first row and column to print. +// +// Input, int IHI, JHI, the last row and column to print. +// +// Input, string TITLE, a title. +// +{ +# define INCX 5 + + int i; + int i2; + int i2hi; + int i2lo; + int inc; + int j; + int j2hi; + int j2lo; + + std::cout << "\n"; + std::cout << title << "\n"; + + for ( i2lo = i4_max ( ilo, 1 ); i2lo <= i4_min ( ihi, m ); i2lo = i2lo + INCX ) + { + i2hi = i2lo + INCX - 1; + i2hi = i4_min ( i2hi, m ); + i2hi = i4_min ( i2hi, ihi ); + + inc = i2hi + 1 - i2lo; + + std::cout << "\n"; + std::cout << " Row: "; + for ( i = i2lo; i <= i2hi; i++ ) + { + std::cout << std::setw(7) << i - 1 << " "; + } + std::cout << "\n"; + std::cout << " Col\n"; + std::cout << "\n"; + + j2lo = i4_max ( jlo, 1 ); + j2hi = i4_min ( jhi, n ); + + for ( j = j2lo; j <= j2hi; j++ ) + { + std::cout << std::setw(5) << j - 1 << ":"; + for ( i2 = 1; i2 <= inc; i2++ ) + { + i = i2lo - 1 + i2; + std::cout << std::setw(14) << a[(i-1)+(j-1)*m]; + } + std::cout << "\n"; + } + } + + return; +# undef INCX +} +//****************************************************************************80 + +void r8mat_write ( std::string output_filename, int m, int n, double table[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8MAT_WRITE writes an R8MAT file. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 11 August 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, string OUTPUT_FILENAME, the output filename. +// +// Input, int M, the spatial dimension. +// +// Input, int N, the number of points. +// +// Input, double TABLE[M*N], the table data. +// +{ + int i; + int j; + std::ofstream output; +// +// Open the file. +// + output.open ( output_filename.c_str ( ) ); + + if ( !output ) + { + std::cerr << "\n"; + std::cerr << "R8MAT_WRITE - Fatal error!\n"; + std::cerr << " Could not open the output file.\n"; + return; + } +// +// Write the data. +// + for ( j = 0; j < n; j++ ) + { + for ( i = 0; i < m; i++ ) + { + output << " " << std::setw(24) << std::setprecision(16) << table[i+j*m]; + } + output << "\n"; + } +// +// Close the file. +// + output.close ( ); + + return; +} +//****************************************************************************80 + +double r8poly_ant_val ( int n, double poly_cof[], double xval ) + +//****************************************************************************80 +// +// Purpose: +// +// R8POLY_ANT_VAL evaluates the antiderivative of an R8POLY in standard form. +// +// Discussion: +// +// The constant term of the antiderivative is taken to be zero. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 June 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the order of the polynomial. +// +// Input, double POLY_COF[N], the polynomial coefficients. POLY_COF[0] +// is the constant term, and POLY_COF[N-1] is the coefficient of X**(N-1). +// +// Input, double XVAL, the point where the antiderivative is to be +// evaluated. +// +// Output, double R8POLY_ANT_VAL, the value of the antiderivative of the polynomial +// at XVAL. +// +{ + int i; + double value; + + value = 0.0; + + for ( i = n - 1; 0 <= i; i-- ) + { + value = ( value + poly_cof[i] / ( double ) ( i + 1 ) ) * xval; + } + + return value; +} +//****************************************************************************80 + +double *r8vec_chebyshev_new ( int n, double a_first, double a_last ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_CHEBYSHEV_NEW creates a vector of Chebyshev spaced values. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 08 June 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Input, double A_FIRST, A_LAST, the first and last entries. +// +// Output, double R8VEC_CHEBYSHEV_NEW[N], a vector of Chebyshev spaced data. +// +{ + double *a; + double c; + int i; + double pi = 3.141592653589793; + double theta; + + a = new double[n]; + + if ( n == 1 ) + { + a[0] = ( a_first + a_last ) / 2.0; + } + else + { + for ( i = 0; i < n; i++ ) + { + theta = ( double ) ( n - i - 1 ) * pi / ( double ) ( n - 1 ); + + c = std::cos ( theta ); + + if ( ( n % 2 ) == 1 ) + { + if ( 2 * i + 1 == n ) + { + c = 0.0; + } + } + + a[i] = ( ( 1.0 - c ) * a_first + + ( 1.0 + c ) * a_last ) + / 2.0; + } + } + return a; +} +//****************************************************************************80 + +int r8vec_compare ( int n, double a[], double b[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_COMPARE compares two R8VEC's. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// The lexicographic ordering is used. +// +// Example: +// +// Input: +// +// A1 = ( 2.0, 6.0, 2.0 ) +// A2 = ( 2.0, 8.0, 12.0 ) +// +// Output: +// +// ISGN = -1 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 23 September 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vectors. +// +// Input, double A[N], B[N], the vectors to be compared. +// +// Output, int R8VEC_COMPARE, the results of the comparison: +// -1, A is lexicographically less than B, +// 0, A is equal to B, +// +1, A is lexicographically greater than B. +// +{ + int isgn; + int k; + + isgn = 0; + + for ( k = 0; k < n; k++ ) + { + if ( a[k] < b[k] ) + { + isgn = -1; + return isgn; + } + else if ( b[k] < a[k] ) + { + isgn = +1; + return isgn; + } + } + return isgn; +} +//****************************************************************************80 + +void r8vec_copy ( int n, double a1[], double a2[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_COPY copies an R8VEC. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 03 July 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vectors. +// +// Input, double A1[N], the vector to be copied. +// +// Output, double A2[N], the copy of A1. +// +{ + int i; + + for ( i = 0; i < n; i++ ) + { + a2[i] = a1[i]; + } + return; +} +//****************************************************************************80 + +double *r8vec_copy_new ( int n, double a1[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_COPY_NEW copies an R8VEC to a "new" R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 03 July 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vectors. +// +// Input, double A1[N], the vector to be copied. +// +// Output, double R8VEC_COPY_NEW[N], the copy of A1. +// +{ + double *a2; + int i; + + a2 = new double[n]; + + for ( i = 0; i < n; i++ ) + { + a2[i] = a1[i]; + } + return a2; +} +//****************************************************************************80 + +double r8vec_diff_norm_li ( int n, double a[], double b[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_DIFF_NORM_LI returns the L-oo norm of the difference of R8VEC's. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// The vector L-oo norm is defined as: +// +// R8VEC_NORM_LI = max ( 1 <= I <= N ) abs ( A(I) ). +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 02 April 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in A. +// +// Input, double A[N], B[N], the vectors. +// +// Output, double R8VEC_DIFF_NORM_LI, the L-oo norm of A - B. +// +{ + int i; + double value; + + value = 0.0; + + for ( i = 0; i < n; i++ ) + { + value = webbur::r8_max ( value, webbur::r8_abs ( a[i] - b[i] ) ); + } + return value; +} +//****************************************************************************80 + +void r8vec_direct_product2 ( int factor_index, int factor_order, + double factor_value[], int factor_num, int point_num, double w[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_DIRECT_PRODUCT2 creates a direct product of R8VEC's. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// To explain what is going on here, suppose we had to construct +// a multidimensional quadrature rule as the product of K rules +// for 1D quadrature. +// +// The product rule will be represented as a list of points and weights. +// +// The J-th item in the product rule will be associated with +// item J1 of 1D rule 1, +// item J2 of 1D rule 2, +// ..., +// item JK of 1D rule K. +// +// In particular, +// X(J) = ( X(1,J1), X(2,J2), ..., X(K,JK)) +// and +// W(J) = W(1,J1) * W(2,J2) * ... * W(K,JK) +// +// So we can construct the quadrature rule if we can properly +// distribute the information in the 1D quadrature rules. +// +// This routine carries out that task for the weights W. +// +// Another way to do this would be to compute, one by one, the +// set of all possible indices (J1,J2,...,JK), and then index +// the appropriate information. An advantage of the method shown +// here is that you can process the K-th set of information and +// then discard it. +// +// Example: +// +// Rule 1: +// Order = 4 +// W(1:4) = ( 2, 3, 5, 7 ) +// +// Rule 2: +// Order = 3 +// W(1:3) = ( 11, 13, 17 ) +// +// Rule 3: +// Order = 2 +// W(1:2) = ( 19, 23 ) +// +// Product Rule: +// Order = 24 +// W(1:24) = +// ( 2 * 11 * 19 ) +// ( 3 * 11 * 19 ) +// ( 4 * 11 * 19 ) +// ( 7 * 11 * 19 ) +// ( 2 * 13 * 19 ) +// ( 3 * 13 * 19 ) +// ( 5 * 13 * 19 ) +// ( 7 * 13 * 19 ) +// ( 2 * 17 * 19 ) +// ( 3 * 17 * 19 ) +// ( 5 * 17 * 19 ) +// ( 7 * 17 * 19 ) +// ( 2 * 11 * 23 ) +// ( 3 * 11 * 23 ) +// ( 5 * 11 * 23 ) +// ( 7 * 11 * 23 ) +// ( 2 * 13 * 23 ) +// ( 3 * 13 * 23 ) +// ( 5 * 13 * 23 ) +// ( 7 * 13 * 23 ) +// ( 2 * 17 * 23 ) +// ( 3 * 17 * 23 ) +// ( 5 * 17 * 23 ) +// ( 7 * 17 * 23 ) +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 April 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int FACTOR_INDEX, the index of the factor being processed. +// The first factor processed must be factor 0. +// +// Input, int FACTOR_ORDER, the order of the factor. +// +// Input, double FACTOR_VALUE[FACTOR_ORDER], the factor values for +// factor FACTOR_INDEX. +// +// Input, int FACTOR_NUM, the number of factors. +// +// Input, int POINT_NUM, the number of elements in the direct product. +// +// Input/output, double W[POINT_NUM], the elements of the +// direct product, which are built up gradually. +// +// Local Parameters: +// +// Local, integer START, the first location of a block of values to set. +// +// Local, integer CONTIG, the number of consecutive values to set. +// +// Local, integer SKIP, the distance from the current value of START +// to the next location of a block of values to set. +// +// Local, integer REP, the number of blocks of values to set. +// +{ + static int contig = 0; + int i; + int j; + int k; + static int rep = 0; + static int skip = 0; + int start; + + if ( factor_index == 0 ) + { + contig = 1; + skip = 1; + rep = point_num; + for ( i = 0; i < point_num; i++ ) + { + w[i] = 1.0; + } + } + + rep = rep / factor_order; + skip = skip * factor_order; + + for ( j = 0; j < factor_order; j++ ) + { + start = 0 + j * contig; + + for ( k = 1; k <= rep; k++ ) + { + for ( i = start; i < start + contig; i++ ) + { + w[i] = w[i] * factor_value[j]; + } + start = start + skip; + } + } + + contig = contig * factor_order; + + return; +} +//****************************************************************************80 + +double r8vec_dot_product ( int n, double a1[], double a2[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_DOT_PRODUCT computes the dot product of a pair of R8VEC's. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 03 July 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vectors. +// +// Input, double A1[N], A2[N], the two vectors to be considered. +// +// Output, double R8VEC_DOT_PRODUCT, the dot product of the vectors. +// +{ + int i; + double value; + + value = 0.0; + for ( i = 0; i < n; i++ ) + { + value = value + a1[i] * a2[i]; + } + return value; +} +//****************************************************************************80 + +double r8vec_i4vec_dot_product ( int n, double r8vec[], int i4vec[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_I4VEC_DOT_PRODUCT computes the dot product of an R8VEC and an I4VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// An I4VEC is a vector of I4's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 30 June 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vectors. +// +// Input, double R8VEC[N], the first vector. +// +// Input, int I4VEC[N], the second vector. +// +// Output, double R8VEC_I4VEC_DOT_PRODUCT, the dot product of the vectors. +// +{ + int i; + double value; + + value = 0.0; + for ( i = 0; i < n; i++ ) + { + value = value + r8vec[i] * ( double ) ( i4vec[i] ); + } + return value; +} +//****************************************************************************80 + +void r8vec_index_sorted_range ( int n, double r[], int indx[], double r_lo, + double r_hi, int *i_lo, int *i_hi ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_INDEX_SORTED_RANGE: search index sorted vector for elements in a range. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 27 September 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of items in the vector. +// +// Input, double R[N], the index sorted vector. +// +// Input, int INDX[N], the vector used to sort R. +// The vector R[INDX[*]] is sorted. +// +// Input, double R_LO, R_HI, the limits of the range. +// +// Output, int *I_LO, *I_HI, the range of indices +// so that I_LO <= I <= I_HI => R_LO <= R[INDX[I]] <= R_HI. If no +// values in R lie in the range, then I_HI < I_LO will be returned. +// +{ + int i1; + int i2; + int j1; + int j2; +// +// Cases we can handle immediately. +// + if ( r[indx[n-1]] < r_lo ) + { + *i_lo = n; + *i_hi = n - 1; + return; + } + + if ( r_hi < r[indx[0]] ) + { + *i_lo = 0; + *i_hi = -1; + return; + } +// +// Are there are least two intervals? +// + if ( n == 1 ) + { + if ( r_lo <= r[indx[0]] && r[indx[0]] <= r_hi ) + { + *i_lo = 0; + *i_hi = 0; + } + else + { + *i_lo = -1; + *i_hi = -2; + } + return; + } +// +// Bracket R_LO. +// + if ( r_lo <= r[indx[0]] ) + { + *i_lo = 0; + } + else + { +// +// R_LO is in one of the intervals spanned by R(INDX(J1)) to R(INDX(J2)). +// Examine the intermediate interval [R(INDX(I1)), R(INDX(I1+1))]. +// Does R_LO lie here, or below or above? +// + j1 = 0; + j2 = n - 1; + i1 = ( j1 + j2 - 1 ) / 2; + i2 = i1 + 1; + + for ( ; ; ) + { + if ( r_lo < r[indx[i1]] ) + { + j2 = i1; + i1 = ( j1 + j2 - 1 ) / 2; + i2 = i1 + 1; + } + else if ( r[indx[i2]] < r_lo ) + { + j1 = i2; + i1 = ( j1 + j2 - 1 ) / 2; + i2 = i1 + 1; + } + else + { + *i_lo = i1; + break; + } + } + } +// +// Bracket R_HI. +// + if ( r[indx[n-1]] <= r_hi ) + { + *i_hi = n - 1; + } + else + { + j1 = *i_lo; + j2 = n - 1; + i1 = ( j1 + j2 - 1 ) / 2; + i2 = i1 + 1; + + for ( ; ; ) + { + if ( r_hi < r[indx[i1]] ) + { + j2 = i1; + i1 = ( j1 + j2 - 1 ) / 2; + i2 = i1 + 1; + } + else if ( r[indx[i2]] < r_hi ) + { + j1 = i2; + i1 = ( j1 + j2 - 1 ) / 2; + i2 = i1 + 1; + } + else + { + *i_hi = i2; + break; + } + } + } +// +// We expect to have computed the largest I_LO and smallest I_HI such that +// R(INDX(I_LO)) <= R_LO <= R_HI <= R(INDX(I_HI)) +// but what we want is actually +// R_LO <= R(INDX(I_LO)) <= R(INDX(I_HI)) <= R_HI +// which we can usually get simply by incrementing I_LO and decrementing I_HI. +// + if ( r[indx[*i_lo]] < r_lo ) + { + *i_lo = *i_lo + 1; + if ( n - 1 < *i_lo ) + { + *i_hi = *i_lo - 1; + } + } + + if ( r_hi < r[indx[*i_hi]] ) + { + *i_hi = *i_hi - 1; + if ( *i_hi < 0 ) + { + *i_lo = *i_hi + 1; + } + } + + return; +} +//****************************************************************************80 + +void r8vec_indexed_heap_d ( int n, double a[], int indx[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_INDEXED_HEAP_D creates a descending heap from an indexed R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// An indexed R8VEC is an R8VEC of data values, and an R8VEC of N indices, +// each referencing an entry of the data vector. +// +// The function adjusts the index vector INDX so that, for 1 <= J <= N/2, +// we have: +// A[INDX[2*J+1]] <= A[INDX[J]] +// and +// A[INDX[2*J+2]] <= A[INDX[J]] +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 August 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Albert Nijenhuis, Herbert Wilf, +// Combinatorial Algorithms for Computers and Calculators, +// Academic Press, 1978, +// ISBN: 0-12-519260-6, +// LC: QA164.N54. +// +// Parameters: +// +// Input, int N, the size of the index array. +// +// Input, double A[*], the data vector. +// +// Input/output, int INDX[N], the index array. +// Each entry of INDX must be a valid index for the array A. +// On output, the indices have been reordered into a descending heap. +// +{ + int i; + int ifree; + int key; + int m; +// +// Only nodes N/2 - 1 down to 0 can be "parent" nodes. +// + for ( i = ( n / 2 ) - 1; 0 <= i; i-- ) + { +// +// Copy the value out of the parent node. +// Position IFREE is now "open". +// + key = indx[i]; + ifree = i; + + for ( ; ; ) + { +// +// Positions 2*IFREE+1 and 2*IFREE+2 are the descendants of position +// IFREE. (One or both may not exist because they exceed N-1.) +// + m = 2 * ifree + 1; +// +// Does the first position exist? +// + if ( n - 1 < m ) + { + break; + } +// +// Does the second position exist? +// + if ( m + 1 <= n - 1 ) + { +// +// If both positions exist, take the larger of the two values, +// and update M if necessary. +// + if ( a[indx[m]] < a[indx[m+1]] ) + { + m = m + 1; + } + } +// +// If the large descendant is larger than KEY, move it up, +// and update IFREE, the location of the free position, and +// consider the descendants of THIS position. +// + if ( a[indx[m]] <= a[key] ) + { + break; + } + + indx[ifree] = indx[m]; + ifree = m; + } +// +// Once there is no more shifting to do, KEY moves into the free spot IFREE. +// + indx[ifree] = key; + } + + return; +} +//****************************************************************************80 + +int r8vec_indexed_heap_d_extract ( int *n, double a[], int indx[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_INDEXED_HEAP_D_EXTRACT: extract from heap descending indexed R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// An indexed R8VEC is an R8VEC of data values, and an R8VEC of N indices, +// each referencing an entry of the data vector. +// +// The routine finds the maximum value in the heap, returns that value to the +// user, deletes that value from the heap, and restores the heap to its +// proper form. +// +// Note that the argument N must be a variable, which will be decremented +// before return, and that INDX will hold one less value on output than it +// held on input. +// +// This is one of three functions needed to model a priority queue. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 August 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Thomas Cormen, Charles Leiserson, Ronald Rivest, +// Introduction to Algorithms, +// MIT Press, 2001, +// ISBN: 0262032937, +// LC: QA76.C662. +// +// Parameters: +// +// Input/output, int *N, the number of items in the index vector. +// +// Input, double A[*], the data vector. +// +// Input/output, int INDX[N], the index vector. +// +// Output, int R8VEC_INDEXED_HEAP_D_EXTRACT, the index in A of the item of +// maximum value, which has now been removed from the heap. +// +{ + int indx_extract; + + if ( *n < 1 ) + { + std::cerr << "\n"; + std::cerr << "R8VEC_INDEXED_HEAP_D_EXTRACT - Fatal error!\n"; + std::cerr << " The heap is empty.\n"; + std::exit ( 1 ); + } +// +// Get the index of the maximum value. +// + indx_extract = indx[0]; + + if ( *n == 1 ) + { + *n = 0; + return indx_extract; + } +// +// Shift the last index down. +// + indx[0] = indx[*n-1]; +// +// Restore the heap structure. +// + *n = *n - 1; + webbur::r8vec_indexed_heap_d ( *n, a, indx ); + + return indx_extract; +} +//****************************************************************************80 + +void r8vec_indexed_heap_d_insert ( int *n, double a[], int indx[], + int indx_insert ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_INDEXED_HEAP_D_INSERT: insert value into heap descending indexed R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// An indexed R8VEC is an R8VEC of data values, and an R8VEC of N indices, +// each referencing an entry of the data vector. +// +// Note that the argument N must be a variable, and will be incremented before +// return, and that INDX must be able to hold one more entry on output than +// it held on input. +// +// This is one of three functions needed to model a priority queue. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 August 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Thomas Cormen, Charles Leiserson, Ronald Rivest, +// Introduction to Algorithms, +// MIT Press, 2001, +// ISBN: 0262032937, +// LC: QA76.C662. +// +// Parameters: +// +// Input/output, int *N, the number of items in the index vector. +// +// Input, double A[*], the data vector. +// +// Input/output, int INDX[N], the index vector. +// +// Input, int INDX_INSERT, the index in A of the value +// to be inserted into the heap. +// +{ + int i; + int parent; + + *n = *n + 1; + i = *n - 1; + + while ( 0 < i ) + { + parent = ( i - 1 ) / 2; + + if ( a[indx_insert] <= a[indx[parent]] ) + { + break; + } + + indx[i] = indx[parent]; + i = parent; + } + + indx[i] = indx_insert; + + return; +} +//****************************************************************************80 + +int r8vec_indexed_heap_d_max ( int n, double a[], int indx[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_INDEXED_HEAP_D_MAX: maximum value in heap descending indexed R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// An indexed R8VEC is an R8VEC of data values, and an R8VEC of N indices, +// each referencing an entry of the data vector. +// +// This is one of three functions needed to model a priority queue. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 18 August 2010 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Thomas Cormen, Charles Leiserson, Ronald Rivest, +// Introduction to Algorithms, +// MIT Press, 2001, +// ISBN: 0262032937, +// LC: QA76.C662. +// +// Parameters: +// +// Input, int N, the number of items in the index vector. +// +// Input, double A[*], the data vector. +// +// Input, int INDX[N], the index vector. +// +// Output, int R8VEC_INDEXED_HEAP_D_MAX, the index in A of the maximum value +// in the heap. +// +{ + int indx_max; + + indx_max = indx[0]; + + return indx_max; +} +//****************************************************************************80 + +double *r8vec_legendre_new ( int n, double a_first, double a_last ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_LEGENDRE_NEW creates a vector of Chebyshev spaced values. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 17 June 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Input, double A_FIRST, A_LAST, the first and last entries. +// +// Output, double R8VEC_LEGENDRE_NEW[N], a vector of Legendre spaced data. +// +{ + double *a; + int i; + + a = webbur::legendre_zeros ( n ); + + for ( i = 0; i < n; i++ ) + { + a[i] = ( ( 1.0 - a[i] ) * a_first + + ( 1.0 + a[i] ) * a_last ) + / 2.0; + } + return a; +} +//****************************************************************************80 + +double *r8vec_linspace_new ( int n, double a_first, double a_last ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_LINSPACE_NEW creates a vector of linearly spaced values. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 14 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Input, double A_FIRST, A_LAST, the first and last entries. +// +// Output, double R8VEC_LINSPACE_NEW[N], a vector of linearly spaced data. +// +{ + double *a; + int i; + + a = new double[n]; + + if ( n == 1 ) + { + a[0] = ( a_first + a_last ) / 2.0; + } + else + { + for ( i = 0; i < n; i++ ) + { + a[i] = ( ( double ) ( n - 1 - i ) * a_first + + ( double ) ( i ) * a_last ) + / ( double ) ( n - 1 ); + } + } + return a; +} +//****************************************************************************80 + +double r8vec_min ( int n, double r8vec[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_MIN returns the value of the minimum element in an R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 02 July 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the array. +// +// Input, double R8VEC[N], the array to be checked. +// +// Output, double R8VEC_MIN, the value of the minimum element. +// +{ + int i; + double value; + + value = r8vec[0]; + + for ( i = 1; i < n; i++ ) + { + if ( r8vec[i] < value ) + { + value = r8vec[i]; + } + } + return value; +} +//****************************************************************************80 + +double r8vec_min_pos ( int n, double a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_MIN_POS returns the minimum positive value of an R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 08 November 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries. +// +// Input, double A[N], the array. +// +// Output, double R8VEC_MIN_POS, the smallest positive entry, +// or R8_HUGE if no entry is positive. +// +{ + int i; + double r8_huge = 1.0E+30; + double value; + + value = r8_huge; + + for ( i = 0; i < n; i++ ) + { + if ( 0.0 < a[i] ) + { + if ( a[i] < value ) + { + value = a[i]; + } + } + } + return value; +} +//****************************************************************************80 + +void r8vec_print ( int n, double a[], std::string title ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_PRINT prints an R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 16 August 2004 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of components of the vector. +// +// Input, double A[N], the vector to be printed. +// +// Input, string TITLE, a title. +// +{ + int i; + + std::cout << "\n"; + std::cout << title << "\n"; + std::cout << "\n"; + for ( i = 0; i < n; i++ ) + { + std::cout << " " << std::setw(8) << i + << ": " << std::setw(14) << a[i] << "\n"; + } + + return; +} +//****************************************************************************80 + +void r8vec_scale ( double s, int n, double a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_SCALE multiples an R8VEC by a scale factor. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 22 September 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, double S, the scale factor. +// +// Input, int N, the number of entries in the vectors. +// +// Input/output, double A[N], the vector to be scaled. +// On output, A[] = S * A[]. +// +{ + int i; + + for ( i = 0; i < n; i++ ) + { + a[i] = s * a[i]; + } + return; +} +//****************************************************************************80 + +void r8vec_sort_heap_index_a ( int n, double a[], int indx[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_SORT_HEAP_INDEX_A does an indexed heap ascending sort of an R8VEC +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// The sorting is not actually carried out. Rather an index array is +// created which defines the sorting. This array may be used to sort +// or index the array, or to sort or index related arrays keyed on the +// original array. +// +// Once the index array is computed, the sorting can be carried out +// "implicitly: +// +// a(indx(*)) +// +// or explicitly, by the call +// +// r8vec_permute ( n, indx, 0, a ) +// +// after which a(*) is sorted. +// +// Note that the index vector is 0-based. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 02 October 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the array. +// +// Input, double A[N], an array to be index-sorted. +// +// Output, int INDX[N], contains the sort index. The +// I-th element of the sorted array is A(INDX(I)). +// +{ + double aval; + int i; + int indxt; + int ir; + int j; + int l; + + if ( n < 1 ) + { + return; + } + + for ( i = 0; i < n; i++ ) + { + indx[i] = i; + } + + if ( n == 1 ) + { + return; + } + + l = n / 2 + 1; + ir = n; + + for ( ; ; ) + { + if ( 1 < l ) + { + l = l - 1; + indxt = indx[l-1]; + aval = a[indxt]; + } + else + { + indxt = indx[ir-1]; + aval = a[indxt]; + indx[ir-1] = indx[0]; + ir = ir - 1; + + if ( ir == 1 ) + { + indx[0] = indxt; + break; + } + } + + i = l; + j = l + l; + + while ( j <= ir ) + { + if ( j < ir ) + { + if ( a[indx[j-1]] < a[indx[j]] ) + { + j = j + 1; + } + } + + if ( aval < a[indx[j-1]] ) + { + indx[i-1] = indx[j-1]; + i = j; + j = j + j; + } + else + { + j = ir + 1; + } + } + indx[i-1] = indxt; + } + + return; +} +//****************************************************************************80 + +int *r8vec_sort_heap_index_a_new ( int n, double a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_SORT_HEAP_INDEX_A_NEW does an indexed heap ascending sort of an R8VEC +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// The sorting is not actually carried out. Rather an index array is +// created which defines the sorting. This array may be used to sort +// or index the array, or to sort or index related arrays keyed on the +// original array. +// +// Once the index array is computed, the sorting can be carried out +// "implicitly: +// +// a(indx(*)) +// +// or explicitly, by the call +// +// r8vec_permute ( n, indx, 0, a ) +// +// after which a(*) is sorted. +// +// Note that the index vector is 0-based. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 02 October 2010 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the array. +// +// Input, double A[N], an array to be index-sorted. +// +// Output, int R8VEC_SORT_HEAP_INDEX_A_NEW[N], contains the sort index. The +// I-th element of the sorted array is A(INDX(I)). +// +{ + double aval; + int i; + int *indx; + int indxt; + int ir; + int j; + int l; + + if ( n < 1 ) + { + return NULL; + } + + indx = new int[n]; + + for ( i = 0; i < n; i++ ) + { + indx[i] = i; + } + + if ( n == 1 ) + { + return indx; + } + + l = n / 2 + 1; + ir = n; + + for ( ; ; ) + { + if ( 1 < l ) + { + l = l - 1; + indxt = indx[l-1]; + aval = a[indxt]; + } + else + { + indxt = indx[ir-1]; + aval = a[indxt]; + indx[ir-1] = indx[0]; + ir = ir - 1; + + if ( ir == 1 ) + { + indx[0] = indxt; + break; + } + } + + i = l; + j = l + l; + + while ( j <= ir ) + { + if ( j < ir ) + { + if ( a[indx[j-1]] < a[indx[j]] ) + { + j = j + 1; + } + } + + if ( aval < a[indx[j-1]] ) + { + indx[i-1] = indx[j-1]; + i = j; + j = j + j; + } + else + { + j = ir + 1; + } + } + indx[i-1] = indxt; + } + + return indx; +} +//****************************************************************************80 + +void r8vec_stutter ( int n, double a[], int m, double am[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_STUTTER makes a "stuttering" copy of an R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Applying a stuttering factor M of 3, the vector A = ( 1, 5, 8 ) becomes +// AM = ( 1, 1, 1, 5, 5, 5, 8, 8, 8 ). +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 28 March 2011 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the size of the input vector. +// +// Input, double A[N], the vector. +// +// Input, int M, the "stuttering factor". +// +// Output, double AM[M*N], the stuttering vector. +// +{ + int i; + int j; + int k; + + k = 0; + for ( i = 0; i < n; i++ ) + { + for ( j = 0; j < m; j++ ) + { + am[k] = a[i]; + k = k + 1; + } + } + return; +} +//****************************************************************************80 + +double r8vec_sum ( int n, double a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_SUM returns the sum of an R8VEC. +// +// Discussion: +// +// An R8VEC is a double precision vector. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 15 October 2004 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Input, double A[N], the vector. +// +// Output, double R8VEC_SUM, the sum of the vector. +// +{ + int i; + double value; + + value = 0.0; + for ( i = 0; i < n; i++ ) + { + value = value + a[i]; + } + + return value; +} +//****************************************************************************80 + +void r8vec_uniform_01 ( int n, int *seed, double r[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_UNIFORM_01 returns a unit pseudorandom R8VEC. +// +// Discussion: +// +// This routine implements the recursion +// +// seed = ( 16807 * seed ) mod ( 2^31 - 1 ) +// u = seed / ( 2^31 - 1 ) +// +// The integer arithmetic never requires more than 32 bits, +// including a sign bit. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 August 2004 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Paul Bratley, Bennett Fox, Linus Schrage, +// A Guide to Simulation, +// Second Edition, +// Springer, 1987, +// ISBN: 0387964673, +// LC: QA76.9.C65.B73. +// +// Bennett Fox, +// Algorithm 647: +// Implementation and Relative Efficiency of Quasirandom +// Sequence Generators, +// ACM Transactions on Mathematical Software, +// Volume 12, Number 4, December 1986, pages 362-376. +// +// Pierre L'Ecuyer, +// Random Number Generation, +// in Handbook of Simulation, +// edited by Jerry Banks, +// Wiley, 1998, +// ISBN: 0471134031, +// LC: T57.62.H37. +// +// Peter Lewis, Allen Goodman, James Miller, +// A Pseudo-Random Number Generator for the System/360, +// IBM Systems Journal, +// Volume 8, Number 2, 1969, pages 136-143. +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Input/output, int *SEED, a seed for the random number generator. +// +// Output, double R[N], the vector of pseudorandom values. +// +{ + int i; + int i4_huge = 2147483647; + int k; + + if ( *seed == 0 ) + { + std::cerr << "\n"; + std::cerr << "R8VEC_UNIFORM_01 - Fatal error!\n"; + std::cerr << " Input value of SEED = 0.\n"; + std::exit ( 1 ); + } + + for ( i = 0; i < n; i++ ) + { + k = *seed / 127773; + + *seed = 16807 * ( *seed - k * 127773 ) - k * 2836; + + if ( *seed < 0 ) + { + *seed = *seed + i4_huge; + } + + r[i] = ( double ) ( *seed ) * 4.656612875E-10; + } + + return; +} +//****************************************************************************80 + +double *r8vec_uniform_01_new ( int n, int *seed ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_UNIFORM_01_NEW returns a new unit pseudorandom R8VEC. +// +// Discussion: +// +// This routine implements the recursion +// +// seed = ( 16807 * seed ) mod ( 2^31 - 1 ) +// u = seed / ( 2^31 - 1 ) +// +// The integer arithmetic never requires more than 32 bits, +// including a sign bit. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 August 2004 +// +// Author: +// +// John Burkardt +// +// Reference: +// +// Paul Bratley, Bennett Fox, Linus Schrage, +// A Guide to Simulation, +// Second Edition, +// Springer, 1987, +// ISBN: 0387964673, +// LC: QA76.9.C65.B73. +// +// Bennett Fox, +// Algorithm 647: +// Implementation and Relative Efficiency of Quasirandom +// Sequence Generators, +// ACM Transactions on Mathematical Software, +// Volume 12, Number 4, December 1986, pages 362-376. +// +// Pierre L'Ecuyer, +// Random Number Generation, +// in Handbook of Simulation, +// edited by Jerry Banks, +// Wiley, 1998, +// ISBN: 0471134031, +// LC: T57.62.H37. +// +// Peter Lewis, Allen Goodman, James Miller, +// A Pseudo-Random Number Generator for the System/360, +// IBM Systems Journal, +// Volume 8, Number 2, 1969, pages 136-143. +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Input/output, int *SEED, a seed for the random number generator. +// +// Output, double R8VEC_UNIFORM_01_NEW[N], the vector of pseudorandom values. +// +{ + int i; + int i4_huge = 2147483647; + int k; + double *r; + + if ( *seed == 0 ) + { + std::cerr << "\n"; + std::cerr << "R8VEC_UNIFORM_01_NEW - Fatal error!\n"; + std::cerr << " Input value of SEED = 0.\n"; + std::exit ( 1 ); + } + + r = new double[n]; + + for ( i = 0; i < n; i++ ) + { + k = *seed / 127773; + + *seed = 16807 * ( *seed - k * 127773 ) - k * 2836; + + if ( *seed < 0 ) + { + *seed = *seed + i4_huge; + } + + r[i] = ( double ) ( *seed ) * 4.656612875E-10; + } + + return r; +} +//****************************************************************************80 + +void r8vec_zero ( int n, double a[] ) + +//****************************************************************************80 +// +// Purpose: +// +// R8VEC_ZERO zeroes an R8VEC. +// +// Discussion: +// +// An R8VEC is a vector of R8's. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 03 July 2005 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int N, the number of entries in the vector. +// +// Output, double A[N], a vector of zeroes. +// +{ + int i; + + for ( i = 0; i < n; i++ ) + { + a[i] = 0.0; + } + return; +} +//****************************************************************************80 + +void sort_heap_external ( int n, int *indx, int *i, int *j, int isgn ) + +//****************************************************************************80 +// +// Purpose: +// +// SORT_HEAP_EXTERNAL externally sorts a list of items into ascending order. +// +// Discussion: +// +// The actual list is not passed to the routine. Hence it may +// consist of integers, reals, numbers, names, etc. The user, +// after each return from the routine, will be asked to compare or +// interchange two items. +// +// The current version of this code mimics the FORTRAN version, +// so the values of I and J, in particular, are FORTRAN indices. +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 05 February 2004 +// +// Author: +// +// Original FORTRAN77 version by Albert Nijenhuis, Herbert Wilf. +// C++ version by John Burkardt +// +// Reference: +// +// Albert Nijenhuis, Herbert Wilf, +// Combinatorial Algorithms, +// Academic Press, 1978, second edition, +// ISBN 0-12-519260-6. +// +// Parameters: +// +// Input, int N, the length of the input list. +// +// Input/output, int *INDX. +// The user must set INDX to 0 before the first call. +// On return, +// if INDX is greater than 0, the user must interchange +// items I and J and recall the routine. +// If INDX is less than 0, the user is to compare items I +// and J and return in ISGN a negative value if I is to +// precede J, and a positive value otherwise. +// If INDX is 0, the sorting is done. +// +// Output, int *I, *J. On return with INDX positive, +// elements I and J of the user's list should be +// interchanged. On return with INDX negative, elements I +// and J are to be compared by the user. +// +// Input, int ISGN. On return with INDX negative, the +// user should compare elements I and J of the list. If +// item I is to precede item J, set ISGN negative, +// otherwise set ISGN positive. +// +{ + static int i_save = 0; + static int j_save = 0; + static int k = 0; + static int k1 = 0; + static int n1 = 0; +// +// INDX = 0: This is the first call. +// + if ( *indx == 0 ) + { + + i_save = 0; + j_save = 0; + k = n / 2; + k1 = k; + n1 = n; + } +// +// INDX < 0: The user is returning the results of a comparison. +// + else if ( *indx < 0 ) + { + if ( *indx == -2 ) + { + if ( isgn < 0 ) + { + i_save = i_save + 1; + } + j_save = k1; + k1 = i_save; + *indx = -1; + *i = i_save; + *j = j_save; + return; + } + + if ( 0 < isgn ) + { + *indx = 2; + *i = i_save; + *j = j_save; + return; + } + + if ( k <= 1 ) + { + if ( n1 == 1 ) + { + i_save = 0; + j_save = 0; + *indx = 0; + } + else + { + i_save = n1; + j_save = 1; + n1 = n1 - 1; + *indx = 1; + } + *i = i_save; + *j = j_save; + return; + } + k = k - 1; + k1 = k; + } +// +// 0 < INDX: the user was asked to make an interchange. +// + else if ( *indx == 1 ) + { + k1 = k; + } + + for ( ; ; ) + { + + i_save = 2 * k1; + + if ( i_save == n1 ) + { + j_save = k1; + k1 = i_save; + *indx = -1; + *i = i_save; + *j = j_save; + return; + } + else if ( i_save <= n1 ) + { + j_save = i_save + 1; + *indx = -2; + *i = i_save; + *j = j_save; + return; + } + + if ( k <= 1 ) + { + break; + } + + k = k - 1; + k1 = k; + } + + if ( n1 == 1 ) + { + i_save = 0; + j_save = 0; + *indx = 0; + *i = i_save; + *j = j_save; + } + else + { + i_save = n1; + j_save = 1; + n1 = n1 - 1; + *indx = 1; + *i = i_save; + *j = j_save; + } + + return; +} +//****************************************************************************80 + +void timestamp ( ) + +//****************************************************************************80 +// +// Purpose: +// +// TIMESTAMP prints the current YMDHMS date as a time stamp. +// +// Example: +// +// 31 May 2001 09:45:54 AM +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 08 July 2009 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// None +// +{ +# define TIME_SIZE 40 + + static char time_buffer[TIME_SIZE]; + const struct std::tm *tm_ptr; + size_t len; + std::time_t now; + + now = std::time ( NULL ); + tm_ptr = std::localtime ( &now ); + + len = std::strftime ( time_buffer, TIME_SIZE, "%d %B %Y %I:%M:%S %p", tm_ptr ); + + std::cout << time_buffer << "\n"; + + return; +# undef TIME_SIZE +} +//****************************************************************************80 + +void vec_colex_next3 ( int dim_num, int base[], int a[], bool *more ) + +//****************************************************************************80 +// +// Purpose: +// +// VEC_COLEX_NEXT3 generates vectors in colex order. +// +// Discussion: +// +// The vectors are produced in colexical order, starting with +// +// (1, 1, ...,1), +// (2, 1, ...,1), +// ... +// (BASE(1), 1, ...,1) +// +// (1, 2, ...,1) +// (2, 2, ...,1) +// ... +// (BASE(1), 2, ...,1) +// +// (1, 3, ...,1) +// (2, 3, ...,1) +// ... +// (BASE(1), BASE(2), ...,BASE(DIM_NUM)). +// +// Example: +// +// DIM_NUM = 2, +// BASE = { 3, 3 } +// +// 1 1 +// 2 1 +// 3 1 +// 1 2 +// 2 2 +// 3 2 +// 1 3 +// 2 3 +// 3 3 +// +// Licensing: +// +// This code is distributed under the GNU LGPL license. +// +// Modified: +// +// 19 August 2008 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, int DIM_NUM, the spatial dimension. +// +// Input, int BASE[DIM_NUM], the bases to be used in each dimension. +// In dimension I, entries will range from 1 to BASE[I]. +// +// Output, int A[DIM_NUM], the next vector. +// +// Input/output, bool *MORE. Set this variable false before +// the first call. On return, MORE is TRUE if another vector has +// been computed. If MORE is returned FALSE, ignore the output +// vector and stop calling the routine. +// +{ + int i; + + if ( !( *more ) ) + { + for ( i = 0; i < dim_num; i++ ) + { + a[i] = 1; + } + *more = true; + } + else + { + for ( i = 0; i < dim_num; i++ ) + { + a[i] = a[i] + 1; + + if ( a[i] <= base[i] ) + { + return; + } + a[i] = 1; + } + *more = false; + } + + return; +} + + +} Index: /issm/trunk-jpl/externalpackages/dakota/configs/6.2/packages/DDACE/src/Analyzer/MainEffectsExcelOutput.cpp =================================================================== --- /issm/trunk-jpl/externalpackages/dakota/configs/6.2/packages/DDACE/src/Analyzer/MainEffectsExcelOutput.cpp (revision 24649) +++ /issm/trunk-jpl/externalpackages/dakota/configs/6.2/packages/DDACE/src/Analyzer/MainEffectsExcelOutput.cpp (revision 24649) @@ -0,0 +1,284 @@ +#include "MainEffectsExcelOutput.h" + + std::ostringstream ss; + + MainEffectsExcelOutput::MainEffectsExcelOutput(){;} + + MainEffectsExcelOutput::~MainEffectsExcelOutput(){;} + + std::string MainEffectsExcelOutput::outputColumnHeaders + (int numInputs, int numOutputs) { + + std::ostringstream ss; + + /* input variables */ + for (int i=0; i responses = response.responses_; + ss << response.getSumPop(); + } + + /* average of all Observation */ + ss << ","; + if (indexOfInputValue==0) { + DDaceMainEffects::Response response = factor.getResponse(); + ss << response.getAveragePop(); + } + + /* sum of squares for Observation */ + ss << ","; + if (indexOfInputValue==0) { + DDaceMainEffects::Response response = factor.getResponse(); + ss << response.getSumOfSquaresPop(); + } + + /* degrees of freedom for all Observation*/ + ss << ","; + if (indexOfInputValue==0) { + int dTotal = factor.getNumberOfObservations() - 1; + ss << dTotal; + } + + /* variance for all Observations */ + ss << ","; + if (indexOfInputValue==0) { + DDaceMainEffects::Response response = factor.getResponse(); + ss << response.getVariancePop(); + } + + /* sum */ + ss << "," << factor.getLevelSum(indexOfInputValue); + + /* average */ + ss << "," << factor.getLevelAverage(indexOfInputValue); + + /* sum of squares */ + ss << "," << factor.getLevelSumOfSquares(indexOfInputValue); + + /* variance */ + ss << "," << factor.getLevelVariance(indexOfInputValue); + + /* sum of squares between groups */ + ss << ","; + if (indexOfInputValue==0) { + ss << factor.sumOfSquaresBetweenGroups(); + } + + /* degrees of freedom between groups */ + ss << ","; + if (indexOfInputValue==0) { + ss << factor.doFBetween(); + } + + /* variance between groups */ + ss << ","; + if (indexOfInputValue==0) { + ss << factor.varianceBetweenGroups(); + } + + /* sum of squares within groups */ + ss << ","; + if (indexOfInputValue==0) { + ss << factor.sumOfSquaresWithinGroups(); + } + + /* degrees of freedom within groups */ + ss << ","; + if (indexOfInputValue==0) { + ss << factor.doFWithin(); + } + + /* variance within groups */ + ss << ","; + if (indexOfInputValue==0) { + ss << factor.varianceWithinGroups(); + } + + /* F */ + ss << ","; + if (indexOfInputValue==0) { + ss << factor.Fdata(); + } + + + ss << "\n"; + + return(ss.str()); + } + + std::string MainEffectsExcelOutput::computeExcelOutput + (std::vector > vectorInputData, + std::vector > vectorOutputData){ + + std::ostringstream ss; + + /* error check */ + if (vectorInputData.size() == 0) return(""); + if (vectorOutputData.size() == 0) return(""); + + + MainEffectsConverter converter; + + /* Replace every INPUT data value with a counting number */ + VectorCountingNumbersAndCount vectorCountingNumbersAndCount = + converter.convertAllDoublesToCountingNumbers(vectorInputData); + std::vector > vectorInputIndicies = + vectorCountingNumbersAndCount.vectorCountingNumbers; + int numberOfCountingNumbers = vectorCountingNumbersAndCount.count; + + /* How many columns are in the input table? */ + int numInputs = vectorInputData[0].size(); + + /* How many columns are in the output table? */ + int numOutputs = vectorOutputData[0].size(); + + /* output the column headers */ + ss << outputColumnHeaders (numInputs, numOutputs); + + /* pair input column 1 with output column 1 */ + /* pair input column 1 with output column 2 */ + /* pair input column 1 with output column 3 */ + /* etc. */ + /* pair input column 2 with output column 1 */ + /* pair input column 2 with output column 2 */ + /* pair input column 2 with output column 3 */ + /* etc. */ + for (int indexInput=0; indexInput +#include +#include + + +#ifdef SURFPACK_HAVE_BOOST_SERIALIZATION +BOOST_CLASS_EXPORT(nkm::KrigingModel) +#endif + + +namespace nkm { + +using std::cout; +using std::cerr; +using std::endl; +using std::ostringstream; + + +//#define __KRIG_ERR_CHECK__ +#define __NKM_UNBIASED_LIKE__ + + + +// typical constructor +KrigingModel::KrigingModel(const SurfData& sd, const ParamMap& params) + : SurfPackModel(sd,sd.getIOut()), numVarsr(sd.getNVarsr()), + numTheta(numVarsr), numPoints(sdBuild.getNPts()), XR(sdBuild.xr) +{ + //printf("calling the right KrigingModel constructor\n"); fflush(stdout); + + //if the SurfDataScaler class does what it's supposed to (the only private content in sdBuild that a Model can access are the scaling bits and then only through SurfDataScaler, and only the model can see inside the scaler) the next line will cause an error when you try to compile with it uncommented, that is intentional + //printf("scaler->mySd.iout=%d\n",scaler.mySd.iout); + + // OPTIONS PARSING + ParamMap::const_iterator param_it; + + // ************************************************************* + // control verbosity outputLevel + // ************************************************************* + param_it = params.find("verbosity"); + if (param_it != params.end() && param_it->second.size() > 0) + outputLevel=static_cast(std::atoi(param_it->second.c_str())); + // outputLevel is a member of nkm::SurfPackModel which nkm::KrigingModel + // is derived from + + // ******************************************************************** + // does the user want to use derivative information to build the + // Kriging model (e.g. Gradient Enhanced Kriging) + // ******************************************************************** + + buildDerOrder=0; //default is regular Kriging (i.e. not GEK) + param_it = params.find("derivative_order"); + if(param_it != params.end() && param_it->second.size() > 0) + buildDerOrder = std::atoi(param_it->second.c_str()); + if(buildDerOrder==0) {//Kriging + numEqnAvail=numPoints; + nDer=1; + Der.newSize(numVarsr,nDer); Der.zero(); + } else if(buildDerOrder==1) { //Gradient Enhanced Kriging (GEK) + numEqnAvail=(1+numVarsr)*numPoints; + multi_dim_poly_power(Der, numVarsr, 1); //use all mixed partial + //derivatives, up to first order, of the basis functions + nDer=Der.getNCols(); //for GradKrigingModel nDer=(1+numVarsr); + //printf("nDer=%d\n",nDer); + int data_der_order=sdBuild.getDerOrder(); + if(data_der_order<1) { + std::cerr << "the order of derivative information available in the " + << "build data is " << data_der_order << "\n" + << "You need to supply gradients of the output in order to " + << "construct a\nGradient Enhanced Kriging (GEK) Model." + << std::endl; + assert(false); + } + } + else{ + std::cerr << "derivative_order=" << buildDerOrder + << " in the nkm::KrigingModel constructor.\n" + << "For Kriging you must use derivative_order=0.\n" + << "For Gradient Enhanced Kriging (GEK) you must use " + << "derivative_order=1.\nHigher order derivative " + << "enhanced Kriging (e.g. Hessian Enhanced Kriging)\n" + << "has not been implemented." << std::endl; + assert(false); + } + + // ************************************************************* + // detect an anchor point if present this is the one point that + // we make sure that the equationSelectingCholR does not discard + // ************************************************************* + iAnchorPoint=0; + ifHaveAnchorPoint=false; + param_it = params.find("anchor_index"); + if (param_it != params.end() && param_it->second.size() > 0) { + ifHaveAnchorPoint=true; + //printf("nkm::KrigingModel() sees an anchor point\n"); + //fflush(stdout); + iAnchorPoint=std::atoi(param_it->second.c_str()); + //printf("iAnchorPoint=%d\n",iAnchorPoint); + //fflush(stdout); + if(!((0<=iAnchorPoint)&&(iAnchorPointsecond.size() > 0) { + if_user_specified_lower_bounds=true; + if(min_max_xr.putCols(param_it->second,0)) { + std::cerr << "You didn't enter the right number of lower bounds" + << std::endl; + assert(false); + } + } + + bool if_user_specified_upper_bounds=false; + param_it = params.find("upper_bounds"); + if (param_it != params.end() && param_it->second.size() > 0) { + if_user_specified_upper_bounds=true; + if(min_max_xr.putCols(param_it->second,1)) { + std::cerr << "You didn't enter the right number of upper bounds" + << std::endl; + assert(false); + } + } + + if(!(if_user_specified_lower_bounds==if_user_specified_upper_bounds)) { + std::cerr << "Your options are to\n(A) specify both the upper and lower, or\n(B) specify neither the upper nor lower,\nbounds of the domain of the Kriging Model\n"; + assert(false); + } + + if(if_user_specified_lower_bounds==true) { + for(int ixr=0; ixrsecond.size() > 0) { + MtxInt dim_groups(numVarsr,1); + if(dim_groups.putCols(param_it->second,0)) { + std::cerr << "If you specify dimension_groups for any dimensions, " + << "you must specify groups\nfor all dimensions. If you " + << "don't want some of the dimensions to be grouped\n" + << "with other dimensions during scaling, give each of " + << "them their own group." << std::endl; + assert(false); + } + sdBuild.setDimGroups(dim_groups); + } + + scaler.scaleToDefault(); //scale outputs to -0.5<=Y<=0.5 and scale + //real inputs to volume 1 hyper-rectangle centered at 0 if real + //input dimensions are locked or the unit hypercube centered at 0 if + //no dimensions are locked. The scaling is done to let us define + //the feasible region simply (region is defined in create); + + if(buildDerOrder==0) { + sdBuild.getY(Yall); + Yall.reshape(numPoints,1); + } + else if(buildDerOrder==1) { + sdBuild.getUpToDerY(Yall,1); + Yall.reshape(numEqnAvail,1); + //Yall is now a column vector that contains + //[y0, dy_0/dxr_0, ..., dy_0/dxr_{numVarsr-1}, y1, dy_1/dxr_0, ..., y2, ... + // y_{numPoints-1}, dy_{numPoints-1}/dxr_0, ..., + // dy_{numPoints-1}/dx_{numVarsr-1}]^T + } + + // ************************************************************* + // this starts the input section about optimizing or directly + // specifying correlation lengths, it must come after the + // scaling section + // ************************************************************* + + // current options are none (fixed correl) | sampling (guess) | local | + // global | global_local + optimizationMethod = "global"; //the default + //optimizationMethod = "none"; //the default + param_it = params.find("optimization_method"); + if (param_it != params.end() && param_it->second.size() > 0) + optimizationMethod = param_it->second; + + if(optimizationMethod.compare("none")==0) + maxTrials=1; + else if(optimizationMethod.compare("local")==0) + maxTrials=20; + else if(optimizationMethod.compare("sampling")==0) + maxTrials=2*numVarsr+1; + else if(optimizationMethod.compare("global")==0) + maxTrials = 10000; + else if(optimizationMethod.compare("global_local")==0) { + maxTrials = 10000; //ensure it has non-zero as a fail safe but this + //shouldn't be used + maxTrialsGlobal = 500; + maxTrialsLocal = 20; + } + else{ //error checking the input + std::cerr << "KrigingModel() unknown optimization_method [" << optimizationMethod << "] aborting\n"; + assert(false); + } + + //std::cout << "optimization_method=\"" << optimizationMethod << "\"\n"; + + //numStarts is the number of starting locations in a multi-start local search + numStarts=1; //default is a single starting location + param_it = params.find("num_starts"); + if (param_it != params.end() && param_it->second.size() > 0) { + numStarts = std::atoi(param_it->second.c_str()); + if(numStarts<1) { + std::cerr << "You can't specify fewer than one starting location " + << "for the optimization\nof correlation lenghts" + << std::endl; + assert(false); + } + } + + if(!((numStarts==1)||(optimizationMethod.compare("local")==0))) { + std::cerr << "Local optimization is the only optimization method for Kriging that uses the \"num_starts\" key word. Check your input file for errors.\n"; + assert(false); + } + + //std::cout << "num_starts=" << numStarts << "\n"; + + + // does the user want to specify correlation lengths directly? + ifUserSpecifiedCorrLengths=false; //the default is no + param_it = params.find("correlation_lengths"); + if (param_it != params.end() && param_it->second.size() > 0) { + ifUserSpecifiedCorrLengths=true; + //printf("User specifying correlation lengths\n"); fflush(stdout); + + // make sure that the user didn't + // * say they want to global optimize __AND__ + // * specify correlation lengths + if(optimizationMethod.compare("global")==0) { + std::cerr << "You can't both \n (A) use the global optimization method to choose, and \n (B) directly specify \n correlation lengths for the Kriging model.\n"; + assert(false); + } + else if(optimizationMethod.compare("global_local")==0) { + //they can't coarse global followed by local either + std::cerr << "You can't both \n (A) use the coarse global polished by local optimization method to choose, and \n (B) directly specify \n correlation lengths for the Kriging model.\n"; + assert(false); + } + else if(optimizationMethod.compare("sampling")==0) { + // this is only the default number of samples/maxTrials; the user can + // still overide this below + maxTrials+=1; + } + + natLogCorrLen.newSize(numVarsr,1); //allocate space + + //read the correlation lengths in from the string + if(natLogCorrLen.putCols(param_it->second,0)) { + std::cerr << "The specified correlation lengths had the wrong " + << "number of input dimensions." << std::endl; + assert(false); + } + // "natLogCorrLen" currently holds the unscaled correlation LENGTHS, not + // the natural log of the scaled correlation length, we need to fix that + // but first we need to check the input for errors + for(int ixr=0; ixr0.0)) { + std::cerr << "For the Kriging Model, correlation lengths must be strictly positive\n."; + assert(false); + } + + //printf("unscaled corr lens = [%12.6g",natLogCorrLen(0,0)); + //for(int ixr=1; ixrsecond.size() > 0) { + maxTrials = std::atoi(param_it->second.c_str()); + } + + if(!(maxTrials > 0)) { + std::cerr << "You can't specify a maximum number of trials that is " + << "less than or equal\nto zero." << std::endl; + assert(false); + } + + //printf("maxTrials=%d\n",maxTrials); + + + // ************************************************************* + // this starts the input section about the trend function + // ************************************************************* + polyOrderRequested = 2; + ifReducedPoly=false; + param_it = params.find("order"); + if (param_it != params.end() && param_it->second.size() > 0) { + polyOrderRequested = std::atoi(param_it->second.c_str()); + //ssstd::cerr << "polyOrderRequested=" << polyOrderRequested << std::endl; + if(!(polyOrderRequested >= 0)) { + std::cerr << "You can't use a trend function with a polynomial " + << "order less than zero." << std::endl; + assert(false); + } + } + else{ + //if they don't specify a polynomial order use a main effects + //polynomial with order 2 for the trend function, (if they do + //specify a polynomial order assume they mean a full polynomial + //order unless they specify that it's a reduced_polynomial) + ifReducedPoly=true; + } + numTrend.newSize(polyOrderRequested+1,1); + + //cout << "order=" << polyOrder << "\n"; + + //polyOrder = 2; //for debug + //main_effects_poly_power(Poly, numVarsr, polyOrder); //for debug + //commented out for debug + + param_it = params.find("reduced_polynomial"); + if (param_it != params.end() && param_it->second.size() > 0) + if((std::atoi(param_it->second.c_str()))!=0) + ifReducedPoly=true; + + //cout << "ifReducedPoly=" << ifReducedPoly << "\n"; + + if(ifReducedPoly) { + for(polyOrder=0; polyOrder<=polyOrderRequested; ++polyOrder) + numTrend(polyOrder,0)=polyOrder*numVarsr+1; + main_effects_poly_power(Poly, numVarsr, polyOrderRequested); + } + else{ + for(polyOrder=0; polyOrder<=polyOrderRequested; ++polyOrder) + numTrend(polyOrder,0)=num_multi_dim_poly_coef(numVarsr, polyOrder); + multi_dim_poly_power(Poly, numVarsr, polyOrderRequested); + } + + + // ******************************************************************** + // this starts the section about the choice of correlation functions + // need to do build derivative order before this + // ******************************************************************** + corrFunc=DEFAULT_CORR_FUNC; + + //POW_EXP_CORR_FUNC + powExpCorrFuncPow=0.0; //only 1.0<=powExpCorrFunc<=2.0 are allowed + //later if corrFunc==POW_EXP_CORR_FUNC and powExpCorrFuncPow==0.0 we know + //we have an error + param_it = params.find("powered_exponential"); + if(param_it != params.end() && param_it->second.size() > 0) { + if(corrFunc!=DEFAULT_CORR_FUNC) { + std::cerr << "You can only specify one correlation function\n"; + assert(false); + } + corrFunc=POW_EXP_CORR_FUNC; + powExpCorrFuncPow=std::atof(param_it->second.c_str()); + if(!((1.0<=powExpCorrFuncPow)&&(powExpCorrFuncPow<=2.0))){ + std::cerr << "The powered exponential correlation function must have 1.0<=power<=2.0\n"; + assert(false); + } + //need to require 1second.size() > 0) { + if(corrFunc!=DEFAULT_CORR_FUNC) { + std::cerr << "You can only specify one correlation function\n"; + assert(false); + } + if(param_it->second.compare("infinity")==0) { + corrFunc=GAUSSIAN_CORR_FUNC; + //matern nu=infinty is the Gaussian correlation function + } + else{ + corrFunc=MATERN_CORR_FUNC; + maternCorrFuncNu=std::atof(param_it->second.c_str()); + if(!((maternCorrFuncNu==0.5)||(maternCorrFuncNu==1.5)|| + (maternCorrFuncNu==2.5))) { + //could allow more later if 3rd+ order derivatives are enabled later + std::cerr << "For the Matern correlation function the only allowed values for nu are 0.5, 1.5, 2.5, and infinity\n"; + assert(false); + } + if(maternCorrFuncNu==0.5) { + corrFunc=EXP_CORR_FUNC; //matern nu=0.5 is the exponential correlation function + //need to disallow maternCorrFuncNu=0.5 if gradients or higher order derivatives are used to construct the Kriging model + } + //need to disallow maternCorrFuncNu=1.5 it hessians or higher order derivatives are used to construct the Kriging model + } + } + + if(corrFunc==DEFAULT_CORR_FUNC) + corrFunc=GAUSSIAN_CORR_FUNC; + + // ************************************************************* + // this starts the input section HOW to bound the condition + // number, this determines which derivatives of the constraint + // function can be computed analytically so handle that here too + // ************************************************************* + //constraintType="rcond"; //rcond is now the only option for type of + //constraint against ill conditioning + numConFunc=1; + + //convert to the Dakota bitflag convention for derivative orders + int num_analytic_obj_ders_in=0; //analytical derivatives have been removed + int num_analytic_con_ders_in=0; //analytical derivatives have been removed + maxObjDerMode=(static_cast(std::pow(2.0,num_analytic_obj_ders_in+1)))-1; //analytical gradients of objective function + maxConDerMode=(static_cast (std::pow(2.0,num_analytic_con_ders_in+1)))-1; //analytical gradients of constraint function(s) + + maxCondNum=std::pow(1024.0,4); + + // ************************************************************* + // this starts the input section about the nugget which can be + // used to smooth the data and also decrease the condition + // number + // ************************************************************* + + ifChooseNug = false; + //ifChooseNug = true; + ifAssumeRcondZero=false; + param_it = params.find("find_nugget"); + if (param_it != params.end() && param_it->second.size() > 0) { + ifChooseNug = true; + int zero_or_one = std::atoi(param_it->second.c_str()); + if(zero_or_one==0) + ifAssumeRcondZero=true; + } + //ifChooseNug = true ; std::cout << "ifChooseNug=" << ifChooseNug << "\n"; + + // fixed value for now + nug = 0.0; //default + ifPrescribedNug=false; + param_it = params.find("nugget"); + if (param_it != params.end() && param_it->second.size() > 0) { + if(!(ifChooseNug==false)) { + std::cerr << "You can do at most 1 of the following (A) auto-select " + << "the nugget\n(approximately the minimum needed to " + << "satisfy the condition number bound)\n(B) directly " + << "specify a nugget. The default is not to use a nugget " + << "at all\n(i.e. use a nugget of zero)." << std::endl; + assert(false); + } + nug = std::atof(param_it->second.c_str()); + if(!(nug >= 0.0)) { + std::cerr << "The nugget must be greater than or equal to zero." + << std::endl; + assert(false); + } + ifPrescribedNug=true; + } + + // ************************************************************* + // this ends the input parsing now finish up the prep work + // ************************************************************* + preAllocateMaxMemory(); //so we don't have to constantly dynamically + //allocate, the SurfMat class can use a subset of the allocated memory + //without using dynamic reallocation + + // precompute and store the trend function for all build points + if(buildDerOrder==0) //for Kriging + eval_trend_fn(Gall, XR); + else if(buildDerOrder>=1) { //for GEK + //actually this is generic to higher order derivative enhanced Kriging + //(e.g. Hessian Enhanced Kriging) provided that Der is appropriately + //defined + eval_der_trend_fn(Gall, Der, XR); + } else{ + std::cerr << "bogus buildDerOrder=" << buildDerOrder + << " in the constructor when evaluating Gall" << std::endl; + assert(false); + } + + if((ifChooseNug==true)||(ifPrescribedNug==true)) { + //if we're using a nugget then we aren't using pivoted cholesky to + //select an optimal subset of points, that means that the order of + //points aren't going to change so we'll set Y and Gtran to what + //we know they need to be + iPtsKeep.newSize(numPoints,1); + for(int ipt=0; ipt= NORMAL_OUTPUT) { + std::cout << model_summary_string(); + //std::cout << std::endl; + } + + + //variables whose values needed to be retained between sequential call to masterObjectiveAndConstraints for precompute and store strategy to work + prevObjDerMode=prevConDerMode=0; + + //deallocate matrices we no longer need after emulator has been created + //these were made member variables (instead of local variables) to avoid + //the cost of dynamic allocation and deallocation each cycle of the + //optimization of the correlation parameters + scaleRChol.clear(); //matrix + sumAbsColR.clear(); //vector + oneNormR.clear(); //vector + lapackRcondR.clear(); //vector + rcondDblWork.clear(); //vector + rcondIntWork.clear(); //vector + Yall.clear(); //vector + Gall.clear(); //matrix + Gtran.clear(); //matrix + iTrendKeep.clear(); //vector + Z.clear(); //matrix + Ztran_theta.clear(); //vector + deltaXR.clear(); //matrix + R.clear(); //matrix + G_Rinv_Gtran.clear(); //matrix + G_Rinv_Gtran_Chol_Scale.clear(); //vector + G_Rinv_Gtran_Chol_DblWork.clear(); //vector + G_Rinv_Gtran_Chol_IntWork.clear(); //vector + G_Rinv_Y.clear(); //vector + eps.clear(); //vector + prevTheta.clear(); //vector + con.clear(); //vector +} + +std::string KrigingModel::get_corr_func() const { + std::ostringstream oss; + + switch(corrFunc) { + case GAUSSIAN_CORR_FUNC: + oss << "Gaussian"; + break; + case EXP_CORR_FUNC: + oss << "exponential"; + break; + case POW_EXP_CORR_FUNC: + oss << "powered exponential with power=" << powExpCorrFuncPow; + break; + case MATERN_CORR_FUNC: + oss << "Matern " << static_cast(maternCorrFuncNu*2.0) << "/2"; + break; + default: + std::cerr << "unknown correlation function enumerated as " << corrFunc + << std::endl; + assert(false); + } + return (oss.str()); +} + + +std::string KrigingModel::model_summary_string() const { + MtxDbl temp_out_corr_lengths(numVarsr,1); + get_corr_len_from_theta(temp_out_corr_lengths,correlations); + scaler.unScaleXrDist(temp_out_corr_lengths); + + //printf("numPoints=%d numTrend=%d numPointsKeep=%d numWholePointsKeep=%d numExtraDerKeep=%d\n",numPoints,numTrend(polyOrder,0),numPointsKeep,numWholePointsKeep,numExtraDerKeep); + + std::ostringstream oss; + oss << "--- Surfpack Kriging Diagnostics ---\n"; + if(buildDerOrder==0) + oss << "KM: #real inputs=" << numVarsr << "; #pts=" << numPoints + << "; used " << numPointsKeep << "/" << numPoints << " pts;\n"; + else if(buildDerOrder==1) + oss << "GEK: #real inputs=" << numVarsr << "; #pts=" << numPoints + << "; #eqns=" << numEqnAvail << "; used " + << numRowsR << "/" << numEqnAvail << " eqns;\n"; + else{ + oss << "error std::string KrigingModel::model_summary_string() const\n" + << "buildDerOrder=" << buildDerOrder << "; it should be 0 for Kriging" + << " or 1 for Gradient Enhanced Kriging (GEK);" + << " the model_summary_string() function will need to be modified " + << "to handle other build derivative orders.\n"; + } + oss << "using the "; + if(corrFunc==GAUSSIAN_CORR_FUNC) + oss << "Gaussian"; + else if(corrFunc==EXP_CORR_FUNC) + oss << "exponential"; + else if(corrFunc==POW_EXP_CORR_FUNC) + oss << "powered exponential (with power = " << powExpCorrFuncPow << ")"; + else if(corrFunc==MATERN_CORR_FUNC) + oss << "Matern " << maternCorrFuncNu; + else{ + std::cerr << "unknown corr func in model_summary_string()" << std::endl; + assert(false); + } + oss << " correlation function with (unscaled)\n" + << "Correlation lengths=[" << temp_out_corr_lengths(0,0); + for(int ixr=1; ixr1) { + if(ifReducedPoly==true) + oss << "reduced_"; + else oss <<"full "; + } + oss << "polynomial\nof order " << polyOrderRequested << " (with " + << numTrend(polyOrderRequested,0) << " terms) was requested " + << "for the trend function; the build\ndata was "; + if(nTrend1) + oss << "^" << Poly(ixr,itrend); + } + if(itrend=0.0) + oss << "+ "; + if(nterm_on_this_line==3) { + oss << "...\n "; + nterm_on_this_line=0; + } + } + } + oss << "\n------------------------------------\n"; + return (oss.str()); +} + +void KrigingModel::preAllocateMaxMemory() { + //this preallocates the maximum sizce of arrays whose size depends on how many equations were discarded by pivoted Cholesky and they could possibly be allocated to a different size than their maximum the first time they are allocated. + + nTrend=numTrend(polyOrderRequested,0); + Y.newSize(numEqnAvail,1); + Gtran.newSize(numEqnAvail,nTrend); + Rinv_Gtran.newSize(numEqnAvail,nTrend); + G_Rinv_Gtran.newSize(nTrend,nTrend); + G_Rinv_Gtran_Chol.newSize(nTrend,nTrend); + rhs.newSize(numEqnAvail,1); + betaHat.newSize(nTrend,1); + G_Rinv_Y.newSize(nTrend,1); + eps.newSize(numEqnAvail,1); + iPtsKeep.newSize(numPoints,1); + RChol.newSize(numEqnAvail,numEqnAvail); + int nrows = nTrend; + if((ifChooseNug==false)&&(ifPrescribedNug==false)&&(numEqnAvail>nTrend)) + nrows=numEqnAvail; + scaleRChol.newSize(nrows,3); + lapackRcondR.newSize(nrows,1); + + return; +} + +// BMA TODO: combine these two functions? + +/// evaluate (y) the Kriging Model at a single point (xr) +double KrigingModel::evaluate(const MtxDbl& xr) +{ + if(buildDerOrder==0) { + //you wouldn't want to do this for Gradient Enhanced Kriging + //i.e. if gradients of y were used as inputs + double singular_y; + if(scaler.isYSingular(0,singular_y)) + return singular_y; + } + + //assert( (numVarsr == xr.getNCols()) && (xr.getNRows() == 1) ); + MtxDbl g(nTrend,1), r(numRowsR,1); + + /* + printf("double evaluate()\n"); + printf("xr=[%20.14g", xr(0,0)); + for(int ixr=1; ixr y = betaHat^T*g + matrix_mult(y, betaHat, g, 0.0, 1.0,'T','N'); + + //y=1.0*y+1.0*r*rhs where rhs=R^-1*(Y-G(XR)^T*betaHat), initial y=betaHat^T*g => y=betaHat^T*g+rhs^T*r + matrix_mult(y, rhs , r, 1.0, 1.0,'T','N'); + + scaler.unScaleYOther(y); + + //printf("y is correct for ValidateMain because it isn't being unscaled\n"); + + return y; +} + +MtxDbl& KrigingModel::evaluate_d1y(MtxDbl& d1y, const MtxDbl& xr) +{ + int nptsxr=xr.getNCols(); +#ifdef __KRIG_ERR_CHECK__ + assert((numVarsr == xr.getNRows())&&(00) + break; + //printf("ixr=%d ",ixr); +#ifdef __KRIG_ERR_CHECK__ + assert(ixr==ider); +#endif + + double d1y_unscale_factor=scaler.unScaleFactorDerY(ixr); + //printf("d1y_usf=%g\n",d1y_unscale_factor); + + dcorrelation_matrix_dxI(d1r, r, xr_scaled, ixr); + matrix_mult(temp_vec,rhs,d1r,0.0,1.0,'T'); + + for(int ipt=0; ipt0.0)) { + //printf("adj_var=%g unscaled_unadj_var=%g rcondR=%g\n",adj_var,unscaled_unadj_var,rcondR); + //fflush(stdout); + //} + adj_var=std::fabs(adj_var); //hack to handle "negative zero" variance (numerical precision round off error) + if(adj_var<0.0) { + printf("NKM setting adj_var to zero adj_var=%g unadj_var=%g rcondR=%g\n",adj_var,unscaled_unadj_var,rcondR); + adj_var=0.0; + } + else if(adj_var==0.0) + printf("NKM adj_var is zero =%g\n",adj_var); + else if(!(adj_var>=0.0)) + printf("double NKM_KrigingModel::eval_variance(...) adj_var=nan rcondR=%g\n",rcondR); + + return adj_var; +} + +/** Evaluate the adjusted variance for a collection of points using matrix + ops (i.e. BLAS and LAPACK) as much as possible) + adj_var=unadjvar* + (1-r^T*R^-1*r+(g-G*R^-1*r)^T*(G*R^-1*G^T)^-1*(g-G*R^-1*r)) + on a point by point basis */ +MtxDbl& KrigingModel:: eval_variance(MtxDbl& adj_var, const MtxDbl& xr) +{ +#ifdef __KRIG_ERR_CHECK__ + assert(numVarsr==xr.getNRows()); +#endif + int nptsxr=xr.getNCols(); + adj_var.newSize(1,nptsxr); + MtxDbl g_minus_G_Rinv_r(nTrend,nptsxr), r(numRowsR,nptsxr); + + double unscaled_unadj_var=estVarianceMLE; + if(scaler.isUnScaled()) { + eval_trend_fn(g_minus_G_Rinv_r, xr); + correlation_matrix(r, xr); + } + else{ + unscaled_unadj_var*=scaler.unScaleFactorVarY(); + MtxDbl xr_scaled(xr); + scaler.scaleXrOther(xr_scaled); + eval_trend_fn(g_minus_G_Rinv_r, xr_scaled); + correlation_matrix(r, xr_scaled); + } + //right now g_minus_G_Rinv_r actually holds g + + MtxDbl Rinv_r(numRowsR,nptsxr); + MtxDbl G_Rinv_Gtran_inv_g_minus_G_Rinv_r(nTrend,nptsxr); + + solve_after_Chol_fact(Rinv_r,RChol,r); + matrix_mult(g_minus_G_Rinv_r,Rinv_Gtran,r,1.0,-1.0,'T','N'); + //g_minus_G_Rinv_r now holds g-G*R^-1*r (i.e. it's name is correct) + + solve_after_Chol_fact(G_Rinv_Gtran_inv_g_minus_G_Rinv_r, + G_Rinv_Gtran_Chol,g_minus_G_Rinv_r); + + for(int ipt=0; ipt=0.0)) + printf("MtxDbl& NKM_KrigingModel::eval_variance(...) adj_var(%d)=nan rcondR=%g\n",ipt,rcondR); + } + + return adj_var; +} + +/** set R=(R+nug*I), where the original R is the correlation matrix for the + data that the model is built from. For GEK this generalizes to + R(i,i)=R(i,i)*(1+nug); Modifying the correlation matrix by the inclusion + of a nugget causes the KrigingModel to smooth the data, i.e. approximate + it rather than interpolate it (which is good if you know how big your + measurement noise is), it can also be used to fix an ill conditioned + correlation matrix. The convention is that capital matrices are for + data the model is built from, lower case matrices are for arbitrary + points to evaluate the model at */ +void KrigingModel::apply_nugget_build() { + if(!(nug>0.0)) return; + //printf("applying nugget=%22.16g\n",nug); + + int nrowsR=R.getNRows(); +#ifdef __KRIG_ERR_CHECK__ + assert(nrowsR==R.getNCols()); +#endif + + double one_plus_nug=1.0+nug; + for(int i=0; inumWholePointsKeep) { + //since there's part of another point left and we know that + //there is only one derivative it means that were missing that + //derivative and only have the function value +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)&& + (i==numRowsR-1)); +#endif + deltax=(xr(0,j)-XRreorder(0,ipt)); + r(i,j)=std::exp(-theta*deltax*deltax); + } + } + } else{ //there is more than 1 dimensions and more than one + //evaluation point + for(j=0; jnumWholePointsKeep) { + //the last XR point isn't a "whole point" we dropped some derivatives + //out of its gradient to meet the bound on rcond, numExtraDerKeep + //is the number of derivatives kept for the last point. The + //derivatives of the last point have NOT been reordered, they appear + //in the same order as the input variables +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + //printf("deltax=xr(0,%d)-XRreorder(0,%d);\n",j,ipt); + deltax=xr(0,j)-XRreorder(0,ipt); + krig_r=-correlations(0,0)*deltax*deltax; //=- is correct + for(k=1; knumWholePointsKeep) { + //since there's part of another point left and we know that + //there is only one derivative it means that were missing that + //derivative and only have the function value +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)&& + (i==numRowsR-1)); +#endif + theta_abs_dx=theta*std::fabs(xr(0,j)-XRreorder(0,ipt)); + r(i,j)=(1.0+theta_abs_dx)*std::exp(-theta_abs_dx); //1D correlation + //function + } + } + } + else{ //there is more than 1 dimension + double matern_coef, matern_coef_prod, sum_neg_theta_abs_dx; + for(j=0; jnumWholePointsKeep) { + //the last XR point isn't a "whole point" we dropped some derivatives + //out of its gradient to meet the bound on rcond, numExtraDerKeep + //is the number of derivatives kept for the last point. The + //derivatives of the last point have NOT been reordered, they appear + //in the same order as the input variables +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + theta_abs_dx=correlations(0,0)*std::fabs(xr(0,j)-XRreorder(0,ipt)); + matern_coef_prod=1.0+theta_abs_dx; + sum_neg_theta_abs_dx=-theta_abs_dx; //=- is correct + for(k=1; knumWholePointsKeep) { + //since there's part of another point left and we know that + //there is only one derivative it means that were missing that + //derivative and only have the function value +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)&& + (i==numRowsR-1)); +#endif + theta_abs_dx=theta*std::fabs(xr(0,j)-XRreorder(0,ipt)); + r(i ,j)=(1.0+theta_abs_dx+theta_abs_dx*theta_abs_dx*one_third)* + std::exp(-theta_abs_dx); //1D correlation function + } + } + } + else{ //there is more than 1 dimension + double matern_coef, matern_coef_prod, sum_neg_theta_abs_dx; + for(j=0; jnumWholePointsKeep) { + //the last XR point isn't a "whole point" we dropped some derivatives + //out of its gradient to meet the bound on rcond, numExtraDerKeep + //is the number of derivatives kept for the last point. The + //derivatives of the last point have NOT been reordered, they appear + //in the same order as the input variables +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + theta_abs_dx=correlations(0,0)*std::fabs(xr(0,j)-XRreorder(0,ipt)); + matern_coef_prod=1.0+theta_abs_dx+theta_abs_dx*theta_abs_dx*one_third; + sum_neg_theta_abs_dx=-theta_abs_dx; //=- is correct + for(k=1; knumWholePointsKeep) { + //ipt and i should be what we need them to be +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + neg_two_theta_dx=two_theta*(XRreorder(Ider,ipt)-xr(Ider,j)); + dr(i,j)=r(i,j)*neg_two_theta_dx; + for(k=0; knumWholePointsKeep) { + //ipt and i should be what we need them to be +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + deltax=(xr(Ider,j)-XRreorder(Ider,ipt)); + matern_coef=1.0+theta*std::fabs(deltax); + matern_d1_mult_r=neg_theta_squared*deltax/matern_coef; + dr(i ,j)=r(i,j)*matern_d1_mult_r; + for(k=0; knumWholePointsKeep) { + //ipt and i should be what we need them to be +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + deltax=xr(Ider,j)-XRreorder(Ider,ipt); + theta_abs_dx=theta*std::fabs(deltax); + theta_squared_div_3_matern_coef=theta_squared/ + (3.0*(1.0+theta_abs_dx)+theta_abs_dx*theta_abs_dx); + matern_d1_mult_r=-theta_squared_div_3_matern_coef* + deltax*(1.0+theta_abs_dx); + dr(i ,j)=r(i,j)*matern_d1_mult_r; + for(k=0; knumWholePointsKeep) { + //ipt and i should already have the values we need them to +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + deltax=xr(Jder,j)-XRreorder(Jder,ipt); + thetaJ_abs_dx=thetaJ*std::fabs(deltax); + matern_coef=(1.0+thetaJ_abs_dx); + d2_mult_r=thetaJ_squared*(thetaJ_abs_dx-1.0)/matern_coef; + d2r(i,j)=r(i,j)*d2_mult_r; + for(k=0; knumWholePointsKeep) { + //ipt and i should already have the values we need them to +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + deltax=xr(Jder,j)-XRreorder(Jder,ipt); + thetaJ_abs_dx=thetaJ*std::fabs(deltax); + matern_coef=1.0+thetaJ_abs_dx; + d1_mult_r=-thetaJ_squared*deltax/matern_coef; + d2r(i,j)=drI(i,j)*d1_mult_r; + for(k=0; knumWholePointsKeep) { + //ipt and i should already have the values we need them to +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + deltax=xr(Jder,j)-XRreorder(Jder,ipt); + thetaJ_abs_dx=thetaJ*std::fabs(deltax); + neg_thetaJ_squared_div_3_matern_coef=-thetaJ_squared/ + (3.0*(1.0+thetaJ_abs_dx)+thetaJ_abs_dx*thetaJ_abs_dx); + d2_mult_r=neg_thetaJ_squared_div_3_matern_coef* + (1.0+thetaJ_abs_dx-thetaJ_abs_dx*thetaJ_abs_dx); + d2r(i,j)=r(i,j)*d2_mult_r; + for(k=0; knumWholePointsKeep) { + //ipt and i should already have the values we need them to +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (ipt==numPointsKeep-1)&& + (i==neqn_per_pt*numWholePointsKeep)); +#endif + deltax=xr(Jder,j)-XRreorder(Jder,ipt); + thetaJ_abs_dx=thetaJ*std::fabs(deltax); + thetaJ_squared_div_3_matern_coef=thetaJ_squared/ + (3.0*(1.0+thetaJ_abs_dx)+thetaJ_abs_dx*thetaJ_abs_dx); + d1_mult_r=-thetaJ_squared_div_3_matern_coef* + deltax*(1.0+thetaJ_abs_dx); + d2r(i,j)=drI(i,j)*d1_mult_r; + for(k=0; k0) { + //Gaussian Matern1.5 and Matern2.5 are valid correlation functions for + //Gradient Enhanced Kriging + double temp_double; + int zij, j; + + + if(corrFunc==GAUSSIAN_CORR_FUNC) { + //now handle the first order derivative submatrices, indiviually the first + //order derivative SUBmatrices are anti-symmetric but the whole matrix is + //symmetric + int Ii, Ij, Jj, Ji; //first letter identifies index OF derivative submatrix + //second letter identifies index INTO derivative SUBmatrix + for(int Ider=0; Ider0) { + //deltaXR is only needed for GEK + deltaXR.newSize(ncolsZ,numVarsr); //this ordering (transpose of Z) + //is useful for constructing the GEK R matrix + } + + int ij=0; + if(corrFunc==GAUSSIAN_CORR_FUNC) { + // **************************************************************** + // The Gausssian Correlation Function + // can be used for Gradient Enhanced Kriging (GEK) + // (or more generally, for derivative enhanced Kriging) because + // it is C infinity continuous. + // It uses Z(k,ij) = -(XR(k,i)-XR(k,j))^2 + // if GEK is used we will also compute and store + // deltaXR(ij,k) = XR(k,i)-XR(k,j), the order of indexes is correct + // this transposed ordering is useful for efficient computation of + // the GEK R matrix (using the SUBmatrix construction process) + // **************************************************************** + double dXR; //a temporary variable to make squaring easier + if(buildDerOrder>0) + for(int j=0; j0) { + if(corrFunc==EXP_CORR_FUNC) { + std::cerr << "the exponential correlation function is not a valid choice for Gradient Enhanced Kriging\n"; + assert(!((corrFunc==EXP_CORR_FUNC)&&(buildDerOrder>0))); + } + for(int j=0; j0) { + std::cerr << "the powered exponential correlation function is not a valid choice for Gradient Enhanced Kriging\n"; + assert(!((corrFunc==POW_EXP_CORR_FUNC)&&(buildDerOrder>0))); + } + for(int j=0; j(numEqnAvail); + double sqrt_num_eqn=std::sqrt(dbl_num_eqn); + min_allowed_rcond*=sqrt_num_eqn; //one norm is within a factor of N^0.5 + //of 2 norm + rcondR/=sqrt_num_eqn; //one norm is within a factor of N^0.5 of 2 norm + double min_eig_worst=(rcondR*dbl_num_eqn)/(1.0+(dbl_num_eqn-1.0)*rcondR); + double max_eig_worst=dbl_num_eqn-(dbl_num_eqn-1.0)*min_eig_worst; + nug=(min_allowed_rcond*max_eig_worst-min_eig_worst)/ + (1.0-min_allowed_rcond); + //this nugget will make the worst case scenario meet (with an ==) + //the maxCondNum constraint, I (KRD) don't expect this to + //ever == fail because I don't expect rcond to be *N^-0.5 without + //nugget and be *N^0.5 with nugget while the maximum eigen value + //of R (without nugget) is N-(N-1)*min_eigval (that comes from + //assumming all eigenvalues except the largest are the smallest + //possible for the given rcond) note that rcond is the LAPACK + //ESTIMATE of the 1 norm condition number so there are no 100% + //guarantees. + apply_nugget_build(); //multiply the diagonal elements by (1.0+nug) + reorderCopyRtoRChol(); + + Chol_fact_workspace(RChol,scaleRChol,rcondDblWork,rcondIntWork, + chol_info,rcondR); + } + return; +} + + +/* use Pivoted Cholesky to efficiently select an optimal subset + of available build points from which to construct the Gaussian + Process. Here "optimal" means that, given the current set of + assumed correlation parameters, this subset maximizes the + amount of unique information content in R, note that this is + equivalent to a "best spaced" (for the chosen correlation + function and its parameters) set of points and the output at + those points does is not considered. Thus if you have 2 points + that are very close together but on opposite sides of a + discontinutity it is highly likely that at least one of them + will get discarded */ +void KrigingModel::equationSelectingCholR(){ + if(!((buildDerOrder==0)||(buildDerOrder==1))) { + std::cerr << "buildDerOrder=" << buildDerOrder + << " in void KrigingModel::equationSelectingCholR(). " + << "For Kriging buildDerOrder must equal 0. " + << "For Gradient Enhanced Kriging (GEK) buildDerOrder " + << "must equal 1. Higher order derivative enhanced " + << "Kriging (e.g. Hessian Enhanced Kriging) has not " + << "been implemented." << std::endl; + assert(false); + } + + //polyOrder=polyOrderRequested; + nTrend=numTrend(polyOrderRequested,0); + Rinv_Gtran.newSize(numEqnAvail,nTrend); + + + //printf("Entered equationSelectingCholR()\n"); + double min_allowed_rcond=1.0/maxCondNum; + //printf("min_allowed_rcond=%g\n",min_allowed_rcond); + //exit(0); + //double min_allowed_pivot_est_rcond=256.0/maxCondNum; + + int ld_RChol=RChol.getNRowsAct(); + //printf("ld_RChol=%d\n",ld_RChol); + int chol_info; + RChol.newSize(numPoints,numPoints); + scaleRChol.newSize(numEqnAvail,3); //maximum space needed + rcondDblWork.newSize(3*ld_RChol,1); + rcondIntWork.newSize(ld_RChol,1); + ld_RChol=RChol.getNRowsAct(); + + iPtsKeep.newSize(numPoints,1); + //assign the default order to points + for(int ipt=0; ipt + (inext_lapack_rcondR-iprev_lapack_rcondR)) + /std::log(2.0)); + while((lapackRcondR(inext_lapack_rcondR,0)<=min_allowed_rcond)&& + (inext_lapack_rcondR>iprev_lapack_rcondR)) { + //printf("inWhile\n"); + ++rcond_iter; + icurr_lapack_rcondR=(iprev_lapack_rcondR+inext_lapack_rcondR)/2; + num_eqn_keep=icurr_lapack_rcondR+1; + + //the LAPACK rcond function + DPOCON_F77(&uplo,&num_eqn_keep,RChol.ptr(0,0),&ld_RChol, + oneNormR.ptr(icurr_lapack_rcondR,0), + &rcondR,rcondDblWork.ptr(0,0),rcondIntWork.ptr(0,0), + &info); + lapackRcondR(icurr_lapack_rcondR,0)=rcondR; + //printf("rcond_iter=%d icurr_lapack_rcondR=%d rcondR=%g\n", + //rcond_iter,icurr_lapack_rcondR,rcondR); + + if(rcondR=10) { + printf("RChol(1:10,1:10)=\n"); + for(int i=0; i<10; ++i) { + for(int j=0; j<10; ++j) + printf("%12.6g ",RChol(i,j)); + printf("\n"); + } + printf("\n\n"); + } + */ + + //polyOrder=polyOrderRequested; //redundant but for clarity + + //the following while loop was commented out when adaptive selection of + //the trend basis functions via pivote cholesky factorization of G*R^-1*G^T + //was implemented + //while((numRowsR<=numTrend(polyOrder,0))&&(polyOrder>0)) + //--polyOrder; + + //nTrend=numTrend(polyOrder,0); //commented out because we now select a subset of Poly based using a Pivoted Cholesky factorization of G*R^-1*G^T which happens when trendSelectingPivotedCholesy is called by materObjectiveAndConstraints() (we no longer select SOLELY on polynomial order and number of points + + nTrend=numTrend(polyOrderRequested,0); + + //printf("num_eqn_keep=%d numRowsR=%d polyOrder=%d nTrend=%d rcondR=%g lapackRcondR(num_eqn_keep-1,0)=%g\n",num_eqn_keep,numRowsR,polyOrder,nTrend,rcondR,lapackRcondR(num_eqn_keep-1,0)); + + //we need to downsize Gtran now but we only need to downsize Poly at + //the end of create() + Gtran.newSize(num_eqn_keep,nTrend); //newSize() because we don't care + //about the current contents of Gtran + + Y.newSize(num_eqn_keep,1); //newSize() because we don't care about + //the current contents of Y + + if(buildDerOrder==0) { + // keep only the useful parts for Kriging + numWholePointsKeep=numPointsKeep=num_eqn_keep; + numExtraDerKeep=0; + + /* + if(numPointsKeep>10) { + + MtxDbl RCholDEBUG(numPointsKeep,numPointsKeep); + for(int jpt=0; jpt(std::ceil(static_cast(num_eqn_keep)/ + static_cast(1+numVarsr))); + + if(numPointsKeep==numWholePointsKeep) { + //perhaps a better name would be numLastDerKeep... this is the number + //of derivatives retained for the last point. + numExtraDerKeep==numVarsr; + } else + numExtraDerKeep=num_eqn_keep-(1+numWholePointsKeep*(1+numVarsr)); + + //we need to undo the equilibration of RChol, recall that scaleRChol + //is already in the pivoted Cholesky order + for(int j=0; jnumWholePointsKeep) { +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (i==(numWholePointsKeep*(1+numVarsr)))&& + (numWholePointsKeep+1==numPointsKeep)); +#endif + int isrc=iPtsKeep(ipt,0)*(1+numVarsr); + Gtran(i,itrend)=Gall(itrend,isrc); + ++i; + ++isrc; + for(int k=0; knumWholePointsKeep) { +#ifdef __KRIG_ERR_CHECK__ + assert((ipt==numWholePointsKeep)&& + (i==(numWholePointsKeep*(1+numVarsr)))&& + (numWholePointsKeep+1==numPointsKeep)); +#endif + int isrc=iPtsKeep(ipt,0)*(1+numVarsr); + Y(i,0)=Yall(isrc,0); + ++i; + ++isrc; + for(int k=0; k + (inext_lapack_rcond-iprev_lapack_rcond)) + /std::log(2.0)); + while((lapackRcondR(inext_lapack_rcond,0)<=min_allowed_rcond)&& + (inext_lapack_rcond>iprev_lapack_rcond)) { + //printf("inWhile\n"); + ++rcond_iter; + icurr_lapack_rcond=(iprev_lapack_rcond+inext_lapack_rcond)/2; + num_trend_keep=icurr_lapack_rcond+1; + + //the LAPACK rcond function + DPOCON_F77(&uplo,&num_trend_keep,G_Rinv_Gtran_Chol.ptr(0,0), + &ld_G_Rinv_Gtran_Chol,oneNormR.ptr(icurr_lapack_rcond,0), + &rcond_G_Rinv_Gtran,rcondDblWork.ptr(0,0), + rcondIntWork.ptr(0,0),&info); + lapackRcondR(icurr_lapack_rcond,0)=rcond_G_Rinv_Gtran; + //printf("rcond_iter=%d icurr_lapack_rcondR=%d rcondR=%g\n", + //rcond_iter,icurr_lapack_rcondR,rcondR); + + if(rcond_G_Rinv_Gtran 0th derivative) calculate objective function + // if(con_der_mode=1) (1=2^0=> 0th derivative) calculate the constraint + //functions + // ERROR if(con_der_mode>=2) (2=2^1 = 1st derivative) this function does not + // support analytical derivatives of the objective + // function + // ERROR if(con_der_mode>=2) (2=2^1 = 1st derivative) this function does not + // support analytical derivatives of the constraint + // function + + //printf("maxConDerMode=%d con_der_mode=%d maxObjDerMode=%d obj_der_mode=%d\n", + //maxConDerMode,con_der_mode,maxObjDerMode,obj_der_mode); + + //might want to replace this with a thrown exception + assert((maxObjDerMode<=1)&&(maxConDerMode<=1)&& + (0<=obj_der_mode)&&(obj_der_mode<=maxObjDerMode)&& + (0<=con_der_mode)&&(con_der_mode<=maxConDerMode)&& + ((1<=obj_der_mode)||(1<=con_der_mode))); + + //if theta was the same as the last time we called this function than we can reuse some of the things we calculated last time + + if(prevTheta.getNElems()!=numTheta) { + //different number of elements means we can't reuse + prevTheta.newSize(numTheta,1); + prevObjDerMode=prevConDerMode=0; + } + else + for(int k=0; k=DBL_MAX) + //printf("[estVarianceMLE=%g determinant_R=%g]",estVarianceMLE,determinant_R); + + //the objective function being MINIMIZED is the negative of the log + //likelihood (on a per equation basis so numbers will be comparable + //regardless of how many equations there are) + obj=-likelihood; + //printf("[obj=%g]",obj); + + prevObjDerMode=1; //increase prevObjDerMode to the current value + if((obj_der_mode==1)&&(con_der_mode<=prevConDerMode)) { + //we have everything we need so exit early + return; + } + } + + if((prevConDerMode==0)&&(1<=con_der_mode)) { + //calculate the constraint on reciprocal condition number that ensures + //that the correlation matrix is well conditioned. + con.newSize(numConFunc,1); + + if(!(1<=prevObjDerMode)) + std::cerr << "We need to have already calculated rcondR (during the " + << "calculation of the\nobjective function) in order to " + << "calculate the constraint (on rcondR)\nfunction (where " + << "rcondR is the reciprocal of the condition number of R,\n" + << "and R is the ''correlation matrix'')." << std::endl; + else if(!(numConFunc==1)) + std::cerr << "The calling function is asking us for more than one " + << "constraint function\nbut we only have one constraint " + << "function; only rcondR (the reciprocal of\nthe " + << "condition number of the ''correlation matrix'', R) is " + << "constrained." << std::endl; + assert((1<=prevObjDerMode)&&(numConFunc==1)); + + //the matrix is considered "ill-conditioned" if the following constraint + //equation is greater than zero + con(0,0)=1.0-rcondR*maxCondNum; + + prevConDerMode=1; //increase prevConDerMode to current value + if((con_der_mode==1)&&(obj_der_mode<=prevObjDerMode)) { + //we have everything we need so exit early + return; + } + } + + return; +} + + +void KrigingModel::getRandGuess(MtxDbl& guess) const +{ + int mymod = 1048576; //2^20 instead of 10^6 to be kind to the computer + guess.newSize(numVarsr,1); + for(int k=0; k NORMAL_OUTPUT), + evalIdCntr(0), newEvalIdCntr(0), evalIdRefPt(0), newEvalIdRefPt(0), + multiProcEvalFlag(false), ieDedMasterFlag(false), + // See base constructor in DakotaIterator.cpp for full discussion of output + // verbosity. Interfaces support the full granularity in verbosity. + appendIfaceId(true), interfaceRep(NULL), referenceCount(1), asl(NULL) +{ +#ifdef DEBUG + outputLevel = DEBUG_OUTPUT; +#endif // DEBUG + + // Process the algebraic_mappings file (an AMPL .nl file) to get the number + // of variables/responses (currently, the tags are converted to index arrays + // at evaluation time, using the passed vars and response). + // TO DO: parallel bcast of data or very proc reads file? + const String& ampl_file_name + = problem_db.get_string("interface.algebraic_mappings"); + if (!ampl_file_name.empty()) { +#ifdef HAVE_AMPL + algebraicMappings = true; + bool hess_flag + = (problem_db.get_string("responses.hessian_type") == "analytic"); + asl = (hess_flag) ? ASL_alloc(ASL_read_pfgh) : ASL_alloc(ASL_read_fg); + // allow user input of either stub or stub.nl + String stub = (strends(ampl_file_name, ".nl")) ? + String(ampl_file_name, 0, ampl_file_name.size() - 3) : ampl_file_name; + //std::ifstream ampl_nl(ampl_file_name); + fint stub_str_len = stub.size(); + // BMA NOTE: casting away the constness as done historically in DakotaString + char* nonconst_stub = (char*) stub.c_str(); + FILE* ampl_nl = jac0dim(nonconst_stub, stub_str_len); + if (!ampl_nl) { + Cerr << "\nError: failure opening " << ampl_file_name << std::endl; + abort_handler(IO_ERROR); + } + int rtn = (hess_flag) ? pfgh_read(ampl_nl, ASL_return_read_err) + : fg_read(ampl_nl, ASL_return_read_err); + if (rtn) { + Cerr << "\nError: AMPL processing problem with " << ampl_file_name + << std::endl; + abort_handler(IO_ERROR); + } + + // extract input/output tag lists + String row = stub + ".row", col = stub + ".col", ampl_tag; + + std::ifstream ampl_col(col.c_str()); + if (!ampl_col) { + Cerr << "\nError: failure opening " << col.c_str() << std::endl; + abort_handler(IO_ERROR); + } + algebraicVarTags.resize(n_var); + for (size_t i=0; i>>>> algebraicVarTags =\n" << algebraicVarTags + << "\n>>>>> algebraicFnTags =\n" << algebraicFnTags + << "\n>>>>> algebraicFnTypes =\n" << algebraicFnTypes << std::endl; +#endif + +#else + Cerr << "\nError: algebraic_mappings not supported without the AMPL solver " + << "library provided with the Acro package." << std::endl; + abort_handler(-1); +#endif // HAVE_AMPL + } + +#ifdef REFCOUNT_DEBUG + Cout << "Interface::Interface(BaseConstructor, ProblemDescDB&) called to " + << "build base class data for letter object." << std::endl; +#endif +} + + +Interface::Interface(NoDBBaseConstructor, size_t num_fns, short output_level): + interfaceId("NO_SPECIFICATION"), algebraicMappings(false), coreMappings(true), + outputLevel(output_level), currEvalId(0), + fineGrainEvalCounters(outputLevel > NORMAL_OUTPUT), evalIdCntr(0), + newEvalIdCntr(0), evalIdRefPt(0), newEvalIdRefPt(0), multiProcEvalFlag(false), + ieDedMasterFlag(false), appendIfaceId(true), interfaceRep(NULL), + referenceCount(1) +{ +#ifdef DEBUG + outputLevel = DEBUG_OUTPUT; +#endif // DEBUG + +#ifdef REFCOUNT_DEBUG + Cout << "Interface::Interface(NoDBBaseConstructor) called to build base " + << "class data for letter object." << std::endl; +#endif +} + + +/** used in Model envelope class instantiations */ +Interface::Interface(): interfaceRep(NULL), referenceCount(1) +{ } + + +/** Used in Model instantiation to build the envelope. This constructor + only needs to extract enough data to properly execute get_interface, since + Interface::Interface(BaseConstructor, problem_db) builds the + actual base class data inherited by the derived interfaces. */ +Interface::Interface(ProblemDescDB& problem_db): referenceCount(1) +{ +#ifdef REFCOUNT_DEBUG + Cout << "Interface::Interface(ProblemDescDB&) called to instantiate envelope." + << std::endl; +#endif + + // Set the rep pointer to the appropriate interface type + interfaceRep = get_interface(problem_db); + if (!interfaceRep) // bad type or insufficient memory + abort_handler(-1); +} + + +/** used only by the envelope constructor to initialize interfaceRep + to the appropriate derived type. */ +Interface* Interface::get_interface(ProblemDescDB& problem_db) +{ + const unsigned short interface_type = problem_db.get_ushort("interface.type"); +#ifdef REFCOUNT_DEBUG + Cout << "Envelope instantiating letter: Getting interface " + << interface_enum_to_string(interface_type) << std::endl; +#endif + + // In the case where a derived interface type has been selected for managing + // analysis_drivers, then this determines the letter instantiation and any + // algebraic mappings are overlayed by ApplicationInterface. + const String& algebraic_map_file + = problem_db.get_string("interface.algebraic_mappings"); + if (interface_type == SYSTEM_INTERFACE) + return new SysCallApplicInterface(problem_db); + + else if (interface_type == FORK_INTERFACE) { +#if defined(HAVE_SYS_WAIT_H) && defined(HAVE_UNISTD_H) // includes CYGWIN/MINGW + return new ForkApplicInterface(problem_db); +#elif defined(_WIN32) // or _MSC_VER (native MSVS compilers) + return new SpawnApplicInterface(problem_db); +#else + Cerr << "Fork interface requested, but not enabled in this DAKOTA " + << "executable." << std::endl; + return NULL; +#endif + } + + else if (interface_type == TEST_INTERFACE) + return new TestDriverInterface(problem_db); + // Note: in the case of a plug-in direct interface, this object gets replaced + // using Interface::assign_rep(). Error checking in DirectApplicInterface:: + // derived_map_ac() should catch if this replacement fails to occur properly. + +#ifdef DAKOTA_GRID + else if (interface_type == GRID_INTERFACE) + return new GridApplicInterface(problem_db); +#endif + + else if (interface_type == MATLAB_INTERFACE) { +#ifdef DAKOTA_MATLAB + return new MatlabInterface(problem_db); +#else + Cerr << "Direct Matlab interface requested, but not enabled in this " + << "DAKOTA executable." << std::endl; + return NULL; +#endif + } + + else if (interface_type == PYTHON_INTERFACE) { +#ifdef DAKOTA_PYTHON + return new PythonInterface(problem_db); +#else + Cerr << "Direct Python interface requested, but not enabled in this " + << "DAKOTA executable." << std::endl; + return NULL; +#endif + } + + else if (interface_type == SCILAB_INTERFACE) { +#ifdef DAKOTA_SCILAB + return new ScilabInterface(problem_db); +#else + Cerr << "Direct Scilab interface requested, but not enabled in this " + << "DAKOTA executable." << std::endl; + return NULL; +#endif + } + + // Should not be needed since ApproximationInterface is plugged-in from + // DataFitSurrModel using Interface::assign_rep(). + //else if (interface_type == APPROX_INTERFACE) + // return new ApproximationInterface(problem_db, num_acv, num_fns); + + // In the case where only algebraic mappings are used, then no derived map + // functionality is needed and ApplicationInterface is used for the letter. + else if (!algebraic_map_file.empty()) { +#ifdef DEBUG + Cout << ">>>>> new ApplicationInterface: " << algebraic_map_file + << std::endl; +#endif // DEBUG + return new ApplicationInterface(problem_db); + } + + // If the interface type is empty (e.g., from default DataInterface creation + // in ProblemDescDB::check_input()), then ApplicationInterface is the letter. + else if (interface_type == DEFAULT_INTERFACE) { + Cerr << "Warning: empty interface type in Interface::get_interface()." + << std::endl; + return new ApplicationInterface(problem_db); + } + + else { + Cerr << "Invalid interface: " << interface_enum_to_string(interface_type) + << std::endl; + return NULL; + } +} + + +/** Copy constructor manages sharing of interfaceRep and incrementing + of referenceCount. */ +Interface::Interface(const Interface& interface_in) +{ + // Increment new (no old to decrement) + interfaceRep = interface_in.interfaceRep; + if (interfaceRep) // Check for an assignment of NULL + ++interfaceRep->referenceCount; + +#ifdef REFCOUNT_DEBUG + Cout << "Interface::Interface(Interface&)" << std::endl; + if (interfaceRep) + Cout << "interfaceRep referenceCount = " << interfaceRep->referenceCount + << std::endl; +#endif +} + + +/** Assignment operator decrements referenceCount for old interfaceRep, assigns + new interfaceRep, and increments referenceCount for new interfaceRep. */ +Interface Interface::operator=(const Interface& interface_in) +{ + if (interfaceRep != interface_in.interfaceRep) { // normal case: old != new + // Decrement old + if (interfaceRep) // Check for NULL + if ( --interfaceRep->referenceCount == 0 ) + delete interfaceRep; + // Assign and increment new + interfaceRep = interface_in.interfaceRep; + if (interfaceRep) // Check for NULL + ++interfaceRep->referenceCount; + } + // else if assigning same rep, then do nothing since referenceCount + // should already be correct + +#ifdef REFCOUNT_DEBUG + Cout << "Interface::operator=(Interface&)" << std::endl; + if (interfaceRep) + Cout << "interfaceRep referenceCount = " << interfaceRep->referenceCount + << std::endl; +#endif + + return *this; // calls copy constructor since returned by value +} + + +/** Destructor decrements referenceCount and only deletes interfaceRep + if referenceCount is zero. */ +Interface::~Interface() +{ + // Check for NULL pointer + if (interfaceRep) { + --interfaceRep->referenceCount; +#ifdef REFCOUNT_DEBUG + Cout << "interfaceRep referenceCount decremented to " + << interfaceRep->referenceCount << std::endl; +#endif + if (interfaceRep->referenceCount == 0) { +#ifdef REFCOUNT_DEBUG + Cout << "deleting interfaceRep" << std::endl; +#endif + delete interfaceRep; + } + } +} + + +/** Similar to the assignment operator, the assign_rep() function + decrements referenceCount for the old interfaceRep and assigns the + new interfaceRep. It is different in that it is used for + publishing derived class letters to existing envelopes, as opposed + to sharing representations among multiple envelopes (in particular, + assign_rep is passed a letter object and operator= is passed an + envelope object). Letter assignment supports two models as + governed by ref_count_incr: + + \li ref_count_incr = true (default): the incoming letter belongs to + another envelope. In this case, increment the reference count in the + normal manner so that deallocation of the letter is handled properly. + + \li ref_count_incr = false: the incoming letter is instantiated on the + fly and has no envelope. This case is modeled after get_interface(): + a letter is dynamically allocated using new and passed into assign_rep, + the letter's reference count is not incremented, and the letter is not + remotely deleted (its memory management is passed over to the envelope). */ +void Interface::assign_rep(Interface* interface_rep, bool ref_count_incr) +{ + if (interfaceRep == interface_rep) { + // if ref_count_incr = true (rep from another envelope), do nothing as + // referenceCount should already be correct (see also operator= logic). + // if ref_count_incr = false (rep from on the fly), then this is an error. + if (!ref_count_incr) { + Cerr << "Error: duplicated interface_rep pointer assignment without " + << "reference count increment in Interface::assign_rep()." + << std::endl; + abort_handler(-1); + } + } + else { // normal case: old != new + // Decrement old + if (interfaceRep) // Check for NULL + if ( --interfaceRep->referenceCount == 0 ) + delete interfaceRep; + // Assign new + interfaceRep = interface_rep; + // Increment new + if (interfaceRep && ref_count_incr) // Check for NULL & honor ref_count_incr + interfaceRep->referenceCount++; + } + +#ifdef REFCOUNT_DEBUG + Cout << "Interface::assign_rep(Interface*)" << std::endl; + if (interfaceRep) + Cout << "interfaceRep referenceCount = " << interfaceRep->referenceCount + << std::endl; +#endif +} + + +void Interface::fine_grained_evaluation_counters(size_t num_fns) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->fine_grained_evaluation_counters(num_fns); + else if (!fineGrainEvalCounters) { // letter (not virtual) + init_evaluation_counters(num_fns); + fineGrainEvalCounters = true; + } +} + + +void Interface::init_evaluation_counters(size_t num_fns) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->init_evaluation_counters(num_fns); + else { // letter (not virtual) + //if (fnLabels.empty()) { + // fnLabels.resize(num_fns); + // build_labels(fnLabels, "response_fn_"); // generic resp fn labels + //} + if (fnValCounter.size() != num_fns) { + fnValCounter.assign(num_fns, 0); fnGradCounter.assign(num_fns, 0); + fnHessCounter.assign(num_fns, 0); newFnValCounter.assign(num_fns, 0); + newFnGradCounter.assign(num_fns, 0); newFnHessCounter.assign(num_fns, 0); + fnValRefPt.assign(num_fns, 0); fnGradRefPt.assign(num_fns, 0); + fnHessRefPt.assign(num_fns, 0); newFnValRefPt.assign(num_fns, 0); + newFnGradRefPt.assign(num_fns, 0); newFnHessRefPt.assign(num_fns, 0); + } + } +} + + +void Interface::set_evaluation_reference() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->set_evaluation_reference(); + else { // letter (not virtual) + + evalIdRefPt = evalIdCntr; + newEvalIdRefPt = newEvalIdCntr; + + if (fineGrainEvalCounters) { + size_t i, num_fns = fnValCounter.size(); + for (i=0; iprint_evaluation_summary(s, minimal_header, relative_count); + else { // letter (not virtual) + + // standard evaluation summary + if (minimal_header) { + if (interfaceId.empty()) + s << " Interface evaluations"; + else + s << " " << interfaceId << " evaluations"; + } + else { + s << "<<<<< Function evaluation summary"; + if (!interfaceId.empty()) + s << " (" << interfaceId << ')'; + } + int fn_evals = (relative_count) ? evalIdCntr - evalIdRefPt + : evalIdCntr; + int new_fn_evals = (relative_count) ? newEvalIdCntr - newEvalIdRefPt + : newEvalIdCntr; + s << ": " << fn_evals << " total (" << new_fn_evals << " new, " + << fn_evals - new_fn_evals << " duplicate)\n"; + + // detailed evaluation summary + if (fineGrainEvalCounters) { + size_t i, num_fns = std::min(fnValCounter.size(), fnLabels.size()); + for (i=0; ieval_tag_prefix(eval_id_str, append_iface_id); + else { + evalTagPrefix = eval_id_str; + appendIfaceId = append_iface_id; + } +} + + +void Interface::map(const Variables& vars, const ActiveSet& set, + Response& response, bool asynch_flag) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->map(vars, set, response, asynch_flag); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual map function.\n" + << "No default map defined at Interface base class." << std::endl; + abort_handler(-1); + } +} + + +void Interface:: +init_algebraic_mappings(const Variables& vars, const Response& response) +{ + size_t i, num_alg_vars = algebraicVarTags.size(), + num_alg_fns = algebraicFnTags.size(); + + algebraicACVIndices.resize(num_alg_vars); + algebraicACVIds.resize(num_alg_vars); + StringMultiArrayConstView acv_labels = vars.all_continuous_variable_labels(); + SizetMultiArrayConstView acv_ids = vars.all_continuous_variable_ids(); + for (i=0; i nl_vars (reduced AMPL space) + const RealVector& dak_a_c_vars = vars.all_continuous_variables(); + //IntVector dak_a_d_vars = vars.all_discrete_variables(); + Real* nl_vars = new Real [num_alg_vars]; + for (i=0; i algebraic_response + algebraic_response.reset_inactive(); // zero inactive data + Real fn_val; RealVector fn_grad; RealSymMatrix fn_hess; + fint err = 0; + for (i=0; i response fns via AMPL + if (algebraic_asv[i] & 1) { + if (algebraicFnTypes[i] > 0) + fn_val = objval(algebraicFnTypes[i]-1, nl_vars, &err); + else + fn_val = conival(-1-algebraicFnTypes[i], nl_vars, &err); + if (err) { + Cerr << "\nError: AMPL processing failure in objval().\n" << std::endl; + abort_handler(INTERFACE_ERROR); + } + algebraic_response.function_value(fn_val, i); + } + // nl_vars -> response grads via AMPL + if (algebraic_asv[i] & 6) { // need grad for Hessian + fn_grad = algebraic_response.function_gradient_view(i); + if (algebraicFnTypes[i] > 0) + objgrd(algebraicFnTypes[i]-1, nl_vars, fn_grad.values(), &err); + else + congrd(-1-algebraicFnTypes[i], nl_vars, fn_grad.values(), &err); + if (err) { + Cerr << "\nError: AMPL processing failure in objgrad().\n" << std::endl; + abort_handler(INTERFACE_ERROR); + } + } + // nl_vars -> response Hessians via AMPL + if (algebraic_asv[i] & 4) { + fn_hess = algebraic_response.function_hessian_view(i); + // the fullhess calls must follow corresp call to objgrad/congrad + if (algebraicFnTypes[i] > 0) + fullhes(fn_hess.values(), num_alg_vars, algebraicFnTypes[i]-1, + NULL, NULL); + else { + algebraicConstraintWeights.assign(algebraicConstraintWeights.size(), 0); + algebraicConstraintWeights[-1-algebraicFnTypes[i]] = 1; + fullhes(fn_hess.values(), num_alg_vars, num_alg_vars, NULL, + &algebraicConstraintWeights[0]); + } + } + } + delete [] nl_vars; + algebraic_response.function_labels(algebraicFnTags); +#ifdef DEBUG + Cout << ">>>>> algebraic_response.fn_labels\n" + << algebraic_response.function_labels() << std::endl; +#endif // DEBUG + + if (outputLevel > NORMAL_OUTPUT) + Cout << "Algebraic mapping applied.\n"; +#endif // HAVE_AMPL +} + + +/** This function will get invoked even when only algebraic mappings are + active (no core mappings from derived_map), since the AMPL + algebraic_response may be ordered differently from the total_response. + In this case, the core_response object is unused. */ +void Interface:: +response_mapping(const Response& algebraic_response, + const Response& core_response, Response& total_response) +{ + const ShortArray& total_asv = total_response.active_set_request_vector(); + const SizetArray& total_dvv = total_response.active_set_derivative_vector(); + size_t i, j, k, num_total_fns = total_asv.size(), + num_total_vars = total_dvv.size(); + bool grad_flag = false, hess_flag = false; + for (i=0; i num_total_fns) { + Cerr << "Error: response size mismatch in Interface::response_mapping()." + << std::endl; + abort_handler(-1); + } + if ( (grad_flag || hess_flag) && num_alg_vars > num_total_vars) { + Cerr << "Error: derivative variables size mismatch in Interface::" + << "response_mapping()." << std::endl; + abort_handler(-1); + } + SizetArray algebraic_dvv_indices; + if (grad_flag || hess_flag) { + algebraic_dvv_indices.resize(num_alg_vars); + using Pecos::find_index; + for (i=0; ifinal_eval_id_tag(iface_eval_id); + + if (appendIfaceId) + return evalTagPrefix + "." + boost::lexical_cast(iface_eval_id); + return evalTagPrefix; +} + + +int Interface::algebraic_function_type(String functionTag) +{ +#ifdef HAVE_AMPL + int i; + for (i=0; isynch(); +} + + +const IntResponseMap& Interface::synch_nowait() +{ + if (!interfaceRep) { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual synch_nowait " + << "function.\nNo default synch_nowait defined at Interface base " + << "class." << std::endl; + abort_handler(-1); + } + + return interfaceRep->synch_nowait(); +} + + +void Interface::serve_evaluations() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->serve_evaluations(); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual serve_evaluations " + << "function.\nNo default serve_evaluations defined at Interface" + << " base class." << std::endl; + abort_handler(-1); + } +} + + +void Interface::stop_evaluation_servers() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->stop_evaluation_servers(); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual stop_evaluation_" + << "servers fn.\nNo default stop_evaluation_servers defined at " + << "Interface base class." << std::endl; + abort_handler(-1); + } +} + + +void Interface::init_communicators(const IntArray& message_lengths, + int max_eval_concurrency) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->init_communicators(message_lengths, max_eval_concurrency); + else { // letter lacking redefinition of virtual fn. + // ApproximationInterfaces: do nothing + } +} + + +void Interface::set_communicators(const IntArray& message_lengths, + int max_eval_concurrency) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->set_communicators(message_lengths, max_eval_concurrency); + else { // letter lacking redefinition of virtual fn. + // ApproximationInterfaces: do nothing + } +} + + +/* +void Interface::free_communicators() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->free_communicators(); + else { // letter lacking redefinition of virtual fn. + // default is no-op + } +} +*/ + + +void Interface::init_serial() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->init_serial(); + else { // letter lacking redefinition of virtual fn. + // ApproximationInterfaces: do nothing + } +} + + +int Interface::asynch_local_evaluation_concurrency() const +{ + if (interfaceRep) // envelope fwd to letter + return interfaceRep->asynch_local_evaluation_concurrency(); + else // letter lacking redefinition of virtual fn. + return 0; // default (redefined only for ApplicationInterfaces) +} + + +short Interface::interface_synchronization() const +{ + if (interfaceRep) // envelope fwd to letter + return interfaceRep->interface_synchronization(); // ApplicationInterfaces + else // letter lacking redefinition of virtual fn. + return SYNCHRONOUS_INTERFACE; // default (ApproximationInterfaces) +} + + +int Interface::minimum_points(bool constraint_flag) const +{ + if (interfaceRep) // envelope fwd to letter + return interfaceRep->minimum_points(constraint_flag); + else // letter lacking redefinition of virtual fn. + return 0; // default (currently redefined only for ApproximationInterfaces) +} + + +int Interface::recommended_points(bool constraint_flag) const +{ + if (interfaceRep) // envelope fwd to letter + return interfaceRep->recommended_points(constraint_flag); + else // letter lacking redefinition of virtual fn. + return 0; // default (currently redefined only for ApproximationInterfaces) +} + + +void Interface::approximation_function_indices(const IntSet& approx_fn_indices) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->approximation_function_indices(approx_fn_indices); + // else: default implementation is no-op +} + + +void Interface:: +update_approximation(const Variables& vars, const IntResponsePair& response_pr) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->update_approximation(vars, response_pr); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual update_approximation" + << "(Variables, IntResponsePair) function.\n This interface " + << "does not support approximation updating." << std::endl; + abort_handler(-1); + } +} + + +void Interface:: +update_approximation(const RealMatrix& samples, const IntResponseMap& resp_map) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->update_approximation(samples, resp_map); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual update_approximation" + << "(RealMatrix, IntResponseMap) function.\n This interface " + << "does not support approximation updating." << std::endl; + abort_handler(-1); + } +} + + +void Interface:: +update_approximation(const VariablesArray& vars_array, + const IntResponseMap& resp_map) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->update_approximation(vars_array, resp_map); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual update_approximation" + << "(VariablesArray, IntResponseMap) function.\n This interface " + << "does not support approximation updating." << std::endl; + abort_handler(-1); + } +} + + +void Interface:: +append_approximation(const Variables& vars, const IntResponsePair& response_pr) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->append_approximation(vars, response_pr); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual append_approximation" + << "(Variables, IntResponsePair) function.\n This interface " + << "does not support approximation appending." << std::endl; + abort_handler(-1); + } +} + + +void Interface:: +append_approximation(const RealMatrix& samples, const IntResponseMap& resp_map) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->append_approximation(samples, resp_map); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual append_approximation" + << "(RealMatrix, IntResponseMap) function.\n This interface " + << "does not support approximation appending." << std::endl; + abort_handler(-1); + } +} + + +void Interface:: +append_approximation(const VariablesArray& vars_array, + const IntResponseMap& resp_map) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->append_approximation(vars_array, resp_map); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual append_approximation" + << "(VariablesArray, IntResponseMap) function.\n This interface " + << "does not support approximation appending." << std::endl; + abort_handler(-1); + } +} + + +void Interface:: +build_approximation(const RealVector& c_l_bnds, const RealVector& c_u_bnds, + const IntVector& di_l_bnds, const IntVector& di_u_bnds, + const RealVector& dr_l_bnds, const RealVector& dr_u_bnds) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->build_approximation(c_l_bnds, c_u_bnds, di_l_bnds, di_u_bnds, + dr_l_bnds, dr_u_bnds); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual build_approximation" + << "() function.\n This interface does not support " + << "approximations." << std::endl; + abort_handler(-1); + } +} + + +void Interface:: +rebuild_approximation(const BoolDeque& rebuild_deque) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->rebuild_approximation(rebuild_deque); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual rebuild_" + << "approximation() function.\n This interface does not " + << "support approximations." << std::endl; + abort_handler(-1); + } +} + + +void Interface::pop_approximation(bool save_surr_data) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->pop_approximation(save_surr_data); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual pop_approximation" + << "(bool)\n function. This interface does not support " + << "approximation\n data removal." << std::endl; + abort_handler(-1); + } +} + + +void Interface::restore_approximation() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->restore_approximation(); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual restore_" + << "approximation() function.\n This interface does not " + << "support approximation restoration." << std::endl; + abort_handler(-1); + } +} + + +bool Interface::restore_available() +{ + if (!interfaceRep) { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual restore_" + << "available() function.\n This interface does not " + << "support approximation restoration queries." << std::endl; + abort_handler(-1); + } + return interfaceRep->restore_available(); +} + + +void Interface::finalize_approximation() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->finalize_approximation(); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual finalize_" + << "approximation() function.\n This interface does not " + << "support approximation finalization." << std::endl; + abort_handler(-1); + } +} + + +void Interface::store_approximation() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->store_approximation(); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual store_" + << "approximation() function.\n This interface does not " + << "support approximation storage." << std::endl; + abort_handler(-1); + } +} + + +void Interface::combine_approximation(short corr_type) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->combine_approximation(corr_type); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual combine_" + << "approximation() function.\n This interface does not " + << "support approximation combination." << std::endl; + abort_handler(-1); + } +} + + +void Interface::clear_current() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->clear_current(); + else { // letter lacking redefinition of virtual fn. + // ApplicationInterfaces: do nothing + } +} + + +void Interface::clear_all() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->clear_all(); + else { // letter lacking redefinition of virtual fn. + // ApplicationInterfaces: do nothing + } +} + + +void Interface::clear_saved() +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->clear_saved(); + else { // letter lacking redefinition of virtual fn. + // ApplicationInterfaces: do nothing + } +} + + +SharedApproxData& Interface::shared_approximation() +{ + if (!interfaceRep) { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual shared_approximation" + << "() function.\nThis interface does not support approximations." + << std::endl; + abort_handler(-1); + } + + // envelope fwd to letter + return interfaceRep->shared_approximation(); +} + + +std::vector& Interface::approximations() +{ + if (!interfaceRep) { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual approximations() " + << "function.\n This interface does not support approximations." + << std::endl; + abort_handler(-1); + } + + // envelope fwd to letter + return interfaceRep->approximations(); +} + + +const Pecos::SurrogateData& Interface::approximation_data(size_t index) +{ + if (!interfaceRep) { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual approximation_data " + << "function.\n This interface does not support approximations." + << std::endl; + abort_handler(-1); + } + + // envelope fwd to letter + return interfaceRep->approximation_data(index); +} + + +const RealVectorArray& Interface::approximation_coefficients(bool normalized) +{ + if (!interfaceRep) { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual approximation_" + << "coefficients function.\n This interface does not support " + << "approximations." << std::endl; + abort_handler(-1); + } + + // envelope fwd to letter + return interfaceRep->approximation_coefficients(normalized); +} + + +void Interface:: +approximation_coefficients(const RealVectorArray& approx_coeffs, + bool normalized) +{ + if (interfaceRep) // envelope fwd to letter + interfaceRep->approximation_coefficients(approx_coeffs, normalized); + else { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual approximation_" + << "coefficients function.\n This interface does not support " + << "approximations." << std::endl; + abort_handler(-1); + } +} + + +const RealVector& Interface::approximation_variances(const Variables& vars) +{ + if (!interfaceRep) { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual approximation_" + << "variances function.\n This interface does not support " + << "approximations." << std::endl; + abort_handler(-1); + } + + // envelope fwd to letter + return interfaceRep->approximation_variances(vars); +} + + +const StringArray& Interface::analysis_drivers() const +{ + if (!interfaceRep) { // letter lacking redefinition of virtual fn. + Cerr << "Error: Letter lacking redefinition of virtual analysis_drivers " + << "function." << std::endl; + abort_handler(-1); + } + + // envelope fwd to letter + return interfaceRep->analysis_drivers(); +} + + +bool Interface::evaluation_cache() const +{ + if (interfaceRep) + return interfaceRep->evaluation_cache(); + else // letter lacking redefinition of virtual fn. + return false; // default +} + + +void Interface::file_cleanup() const +{ + if (interfaceRep) + interfaceRep->file_cleanup(); + // else no-op +} + +} // namespace Dakota Index: /issm/trunk-jpl/externalpackages/dakota/configs/6.2/src/NonDLocalReliability.cpp =================================================================== --- /issm/trunk-jpl/externalpackages/dakota/configs/6.2/src/NonDLocalReliability.cpp (revision 24649) +++ /issm/trunk-jpl/externalpackages/dakota/configs/6.2/src/NonDLocalReliability.cpp (revision 24649) @@ -0,0 +1,2704 @@ +/* _______________________________________________________________________ + + DAKOTA: Design Analysis Kit for Optimization and Terascale Applications + Copyright 2014 Sandia Corporation. + This software is distributed under the GNU Lesser General Public License. + For more information, see the README file in the top Dakota directory. + _______________________________________________________________________ */ + +//- Class: NonDLocalReliability +//- Description: Implementation code for NonDLocalReliability class +//- Owner: Mike Eldred +//- Checked by: +//- Version: + +#include "dakota_system_defs.hpp" +#include "DakotaResponse.hpp" +#include "ParamResponsePair.hpp" +#include "PRPMultiIndex.hpp" +#include "ProblemDescDB.hpp" +#include "DakotaGraphics.hpp" +#include "NonDLocalReliability.hpp" +#include "NonDAdaptImpSampling.hpp" +#ifdef HAVE_NPSOL +#include "NPSOLOptimizer.hpp" +#endif +#ifdef HAVE_OPTPP +#include "SNLLOptimizer.hpp" +using OPTPP::NLPFunction; +using OPTPP::NLPGradient; +#endif +#include "RecastModel.hpp" +#include "DataFitSurrModel.hpp" +#include "NestedModel.hpp" +#include "Teuchos_LAPACK.hpp" +#include "Teuchos_SerialDenseHelpers.hpp" +#include +#include "dakota_data_io.hpp" + +//#define MPP_CONVERGE_RATE +//#define DEBUG + +static const char rcsId[] = "@(#) $Id: NonDLocalReliability.cpp 4058 2006-10-25 01:39:40Z mseldre $"; + +namespace Dakota { +extern PRPCache data_pairs; // global container + + +// define special values for componentParallelMode +//#define SURROGATE_MODEL 1 +#define TRUTH_MODEL 2 + + +// initialization of statics +NonDLocalReliability* NonDLocalReliability::nondLocRelInstance(NULL); + + +NonDLocalReliability:: +NonDLocalReliability(ProblemDescDB& problem_db, Model& model): + NonDReliability(problem_db, model), + initialPtUserSpec( + probDescDB.get_bool("variables.uncertain.initial_point_flag")), + warmStartFlag(true), nipModeOverrideFlag(true), + curvatureDataAvailable(false), kappaUpdated(false), + secondOrderIntType(HOHENRACK), curvatureThresh(1.e-10), warningBits(0) +{ + // check for suitable gradient and variables specifications + if (iteratedModel.gradient_type() == "none") { + Cerr << "\nError: local_reliability requires a gradient specification." + << std::endl; + abort_handler(-1); + } + if (numEpistemicUncVars) { + Cerr << "Error: epistemic variables are not supported in local " + << "reliability methods." << std::endl; + abort_handler(-1); + } + + if (mppSearchType) { // default is MV = 0 + + // Map MPP search NIP/SQP algorithm specification into an NPSOL/OPT++ + // selection based on configuration availability. +#if !defined(HAVE_NPSOL) && !defined(HAVE_OPTPP) + Cerr << "Error: this executable not configured with NPSOL or OPT++.\n" + << " NonDLocalReliability cannot perform MPP search." + << std::endl; + abort_handler(-1); +#endif + unsigned short mpp_optimizer = probDescDB.get_ushort("method.sub_method"); + if (mpp_optimizer == SUBMETHOD_SQP) { +#ifdef HAVE_NPSOL + npsolFlag = true; +#else + Cerr << "\nError: this executable not configured with NPSOL SQP.\n" + << " Please select OPT++ NIP within local_reliability." + << std::endl; + abort_handler(-1); +#endif + } + else if (mpp_optimizer == SUBMETHOD_NIP) { +#ifdef HAVE_OPTPP + npsolFlag = false; +#else + Cerr << "\nError: this executable not configured with OPT++ NIP.\n" + << " please select NPSOL SQP within local_reliability." + << std::endl; + abort_handler(-1); +#endif + } + else if (mpp_optimizer == SUBMETHOD_DEFAULT) { +#ifdef HAVE_NPSOL + npsolFlag = true; +#elif HAVE_OPTPP + npsolFlag = false; +#endif + } + + // Error check for a specification of at least 1 level for MPP methods + if (!totalLevelRequests) { + Cerr << "\nError: An MPP search method requires the specification of at " + << "least one response, probability, or reliability level." + << std::endl; + abort_handler(-1); + } + } + + // Prevent nesting of an instance of a Fortran iterator within another + // instance of the same iterator (which would result in data clashes since + // Fortran does not support object independence). Recurse through all + // sub-models and test each sub-iterator for SOL presence. + // Note 1: This check is performed for DOT, CONMIN, and SOLBase, but not + // for LHS since it is only active in pre-processing. + // Note 2: NPSOL/NLSSOL on the outer loop with NonDLocalReliability on the + // inner loop precludes all NPSOL-based MPP searches; + // NonDLocalReliability on the outer loop with NPSOL/NLSSOL on an + // inner loop is only a problem for the no_approx MPP search (since + // iteratedModel is not invoked w/i an approx-based MPP search). + if (mppSearchType == NO_APPROX && npsolFlag) { + Iterator sub_iterator = iteratedModel.subordinate_iterator(); + if (!sub_iterator.is_null() && + ( sub_iterator.method_name() == NPSOL_SQP || + sub_iterator.method_name() == NLSSOL_SQP || + sub_iterator.uses_method() == NPSOL_SQP || + sub_iterator.uses_method() == NLSSOL_SQP ) ) + sub_iterator.method_recourse(); + ModelList& sub_models = iteratedModel.subordinate_models(); + for (ModelLIter ml_iter = sub_models.begin(); + ml_iter != sub_models.end(); ml_iter++) { + sub_iterator = ml_iter->subordinate_iterator(); + if (!sub_iterator.is_null() && + ( sub_iterator.method_name() == NPSOL_SQP || + sub_iterator.method_name() == NLSSOL_SQP || + sub_iterator.uses_method() == NPSOL_SQP || + sub_iterator.uses_method() == NLSSOL_SQP ) ) + sub_iterator.method_recourse(); + } + } + + // Map response Hessian specification into taylorOrder for use by MV/AMV/AMV+ + // variants. Note that taylorOrder and integrationOrder are independent + // (although the Hessian specification required for 2nd-order integration + // means that taylorOrder = 2 will be used for MV/AMV/AMV+; taylorOrder = 2 + // may however be used with 1st-order integration). + const String& hess_type = iteratedModel.hessian_type(); + taylorOrder = (hess_type != "none" && mppSearchType <= AMV_PLUS_U) ? 2 : 1; + + // assign iterator-specific defaults for approximation-based MPP searches + if (maxIterations < 0 && // DataMethod default = -1 + mppSearchType >= AMV_PLUS_X && mppSearchType < NO_APPROX) // approx-based + maxIterations = 25; + + // The model of the limit state in u-space (uSpaceModel) is constructed here + // one time. The RecastModel for the RIA/PMA formulations varies with the + // level requests and is constructed for each level within mpp_search(). + + // Instantiate the Nataf Recast and any DataFit model recursions. Recast is + // bounded to 10 std devs in u space. This is particularly important for PMA + // since an SQP-based optimizer will not enforce the constraint immediately + // and min +/-g has been observed to have significant excursions early on + // prior to the u'u = beta^2 constraint enforcement bringing it back. A + // large excursion can cause overflow; a medium excursion can cause poor + // performance since far-field info is introduced into the BFGS Hessian. + if (mppSearchType == AMV_X || mppSearchType == AMV_PLUS_X || + mppSearchType == TANA_X) { // Recast( DataFit( iteratedModel ) ) + + // Construct g-hat(x) using a local/multipoint approximation over the + // uncertain variables (using the same view as iteratedModel). + Model g_hat_x_model; + String sample_reuse, approx_type = (mppSearchType == TANA_X) ? + "multipoint_tana" : "local_taylor"; + UShortArray approx_order(1, taylorOrder); + short corr_order = -1, corr_type = NO_CORRECTION, + data_order = (taylorOrder == 2) ? 7 : 3; + int samples = 0, seed = 0; + Iterator dace_iterator; + //const Variables& curr_vars = iteratedModel.current_variables(); + ActiveSet surr_set = iteratedModel.current_response().active_set(); // copy + surr_set.request_values(3); // surrogate gradient evals + g_hat_x_model.assign_rep(new DataFitSurrModel(dace_iterator, iteratedModel, + surr_set, approx_type, approx_order, corr_type, corr_order, data_order, + outputLevel, sample_reuse), false); + + // transform g_hat_x_model from x-space to u-space + transform_model(g_hat_x_model, uSpaceModel, true); // globally bounded + } + else if (mppSearchType == AMV_U || mppSearchType == AMV_PLUS_U || + mppSearchType == TANA_U) { // DataFit( Recast( iteratedModel ) ) + + // Recast g(x) to G(u) + Model g_u_model; + transform_model(iteratedModel, g_u_model, true); // globally bounded + + // Construct G-hat(u) using a local/multipoint approximation over the + // uncertain variables (using the same view as iteratedModel/g_u_model). + String sample_reuse, approx_type = (mppSearchType == TANA_U) ? + "multipoint_tana" : "local_taylor"; + UShortArray approx_order(1, taylorOrder); + short corr_order = -1, corr_type = NO_CORRECTION, + data_order = (taylorOrder == 2) ? 7 : 3; + int samples = 0, seed = 0; + Iterator dace_iterator; + //const Variables& g_u_vars = g_u_model.current_variables(); + ActiveSet surr_set = g_u_model.current_response().active_set(); // copy + surr_set.request_values(3); // surrogate gradient evals + uSpaceModel.assign_rep(new DataFitSurrModel(dace_iterator, g_u_model, + surr_set, approx_type, approx_order, corr_type, corr_order, data_order, + outputLevel, sample_reuse), false); + } + else if (mppSearchType == NO_APPROX) // Recast( iteratedModel ) + // Recast g(x) to G(u) + transform_model(iteratedModel, uSpaceModel, true); // globally bounded + + // configure a RecastModel with one objective and one equality constraint + // using the alternate minimalist constructor + if (mppSearchType) { + SizetArray recast_vars_comps_total; // default: empty; no change in size + BitArray all_relax_di, all_relax_dr; // default: empty; no discrete relax + mppModel.assign_rep( + new RecastModel(uSpaceModel, recast_vars_comps_total, + all_relax_di, all_relax_dr, 1, 1, 0), false); + RealVector nln_eq_targets(1, false); nln_eq_targets = 0.; + mppModel.nonlinear_eq_constraint_targets(nln_eq_targets); + + // Use NPSOL/OPT++ in "user_functions" mode to perform the MPP search + if (npsolFlag) { + // NPSOL deriv level: 1 = supplied grads of objective fn, 2 = supplied + // grads of constraints, 3 = supplied grads of both. Always use the + // supplied grads of u'u (deriv level = 1 for RIA, deriv level = 2 for + // PMA). In addition, use supplied gradients of G(u) in most cases. + // Exception: deriv level = 3 results in a gradient-based line search, + // which could be too expensive for FORM with numerical grads unless + // seeking parallel load balance. + //int npsol_deriv_level; + //if ( mppSearchType == NO_APPROX && !iteratedModel.asynch_flag() + // && iteratedModel.gradient_type() != "analytic" ) + // npsol_deriv_level = (ria_flag) ? 1 : 2; + //else + // npsol_deriv_level = 3; + //Cout << "Derivative level = " << npsol_deriv_level << '\n'; + + // The gradient-based line search (deriv. level = 3) appears to be + // outperforming the value-based line search in PMA testing. In + // addition, the RIA warm start needs fnGradU so deriv. level = 3 has + // superior performance there as well. Therefore, deriv level = 3 can + // be used for all cases. + int npsol_deriv_level = 3; + + // run a tighter tolerance on approximation-based MPP searches + //Real conv_tol = (mppSearchType == NO_APPROX) ? 1.e-4 : 1.e-6; + Real conv_tol = -1.; // use NPSOL default + +#ifdef HAVE_NPSOL + mppOptimizer.assign_rep(new NPSOLOptimizer(mppModel, npsol_deriv_level, + conv_tol), false); +#endif + } +#ifdef HAVE_OPTPP + else + mppOptimizer.assign_rep(new SNLLOptimizer("optpp_q_newton", mppModel), + false); +#endif + } + + // Map integration specification into integrationOrder. Second-order + // integration requires an MPP search in u-space, and is not warranted for + // unconverged MPP's (AMV variants). In addition, AMV variants only compute + // verification function values at u* (no Hessians). For an AMV-like + // approach with 2nd-order integration, use AMV+ with max_iterations = 1. + const String& integration_method + = probDescDB.get_string("method.nond.reliability_integration"); + if (integration_method.empty() || integration_method == "first_order") + integrationOrder = 1; + else if (integration_method == "second_order") { + if (hess_type == "none") { + Cerr << "\nError: second-order integration requires Hessian " + << "specification." << std::endl; + abort_handler(-1); + } + else if (mppSearchType <= AMV_U) { + Cerr << "\nError: second-order integration only supported for fully " + << "converged MPP methods." << std::endl; + abort_handler(-1); + } + else + integrationOrder = 2; + } + else { + Cerr << "Error: bad integration selection in NonDLocalReliability." + << std::endl; + abort_handler(-1); + } + + if (integrationRefinement) { + for (size_t i=0; i Pecos::SMALL_NUMBER) { + const Pecos::RealVector& x_std_devs = natafTransform.x_std_deviations(); + for (i=0; iz. + size_t rl_len = requestedRespLevels[respFnCount].length(), + pl_len = requestedProbLevels[respFnCount].length(), + bl_len = requestedRelLevels[respFnCount].length(), + gl_len = requestedGenRelLevels[respFnCount].length(); + for (levelCount=0; levelCount Pecos::SMALL_NUMBER) { + Real ratio = (mean - z)/std_dev; + beta = computedRelLevels[respFnCount][levelCount] + = computedGenRelLevels[respFnCount][levelCount] + = (cdfFlag) ? ratio : -ratio; + p = computedProbLevels[respFnCount][levelCount] = probability(beta); + } + else { + if ( ( cdfFlag && mean <= z) || + (!cdfFlag && mean > z) ) { + beta = computedRelLevels[respFnCount][levelCount] + = computedGenRelLevels[respFnCount][levelCount] + = -Pecos::LARGE_NUMBER; + p = computedProbLevels[respFnCount][levelCount] = 1.; + } + else { + beta = computedRelLevels[respFnCount][levelCount] + = computedGenRelLevels[respFnCount][levelCount] + = Pecos::LARGE_NUMBER; + p = computedProbLevels[respFnCount][levelCount] = 0.; + } + } + switch (respLevelTarget) { + case PROBABILITIES: + finalStatistics.function_value(p, statCount); break; + case RELIABILITIES: case GEN_RELIABILITIES: + finalStatistics.function_value(beta, statCount); break; + } + if (final_asv[statCount] & 2) { + Cerr << "Error: response probability/reliability/gen_reliability level " + << "sensitivity not supported for Mean Value." << std::endl; + abort_handler(-1); + } + statCount++; + // Update specialty graphics + if (!subIteratorFlag) + dakota_graphics.add_datapoint(respFnCount, z, p); + } + for (i=0; i= rl_len + pl_len + bl_len ) ); + if (ria_flag) { + requestedTargetLevel = requestedRespLevels[respFnCount][levelCount]; + Cout << "\n>>>>> Reliability Index Approach (RIA) for response level " + << levelCount+1 << " = " << requestedTargetLevel << '\n'; + } + else if (levelCount < rl_len + pl_len) { + index = levelCount - rl_len; + Real p = requestedProbLevels[respFnCount][index]; + Cout << "\n>>>>> Performance Measure Approach (PMA) for probability " + << "level " << index + 1 << " = " << p << '\n'; + // gen beta target for 2nd-order PMA; beta target for 1st-order PMA: + requestedTargetLevel = reliability(p); + + // CDF probability < 0.5 --> CDF beta > 0 --> minimize g + // CDF probability > 0.5 --> CDF beta < 0 --> maximize g + // CDF probability = 0.5 --> CDF beta = 0 --> compute g + // Note: "compute g" means that min/max is irrelevant since there is + // a single G(u) value when the radius beta collapses to the origin + Real p_cdf = (cdfFlag) ? p : 1. - p; + pmaMaximizeG = (p_cdf > 0.5); // updated in update_pma_maximize() + } + else if (levelCount < rl_len + pl_len + bl_len) { + index = levelCount - rl_len - pl_len; + requestedTargetLevel = requestedRelLevels[respFnCount][index]; + Cout << "\n>>>>> Performance Measure Approach (PMA) for reliability " + << "level " << index + 1 << " = " << requestedTargetLevel << '\n'; + Real beta_cdf = (cdfFlag) ? + requestedTargetLevel : -requestedTargetLevel; + pmaMaximizeG = (beta_cdf < 0.); + } + else { + index = levelCount - rl_len - pl_len - bl_len; + requestedTargetLevel = requestedGenRelLevels[respFnCount][index]; + Cout << "\n>>>>> Performance Measure Approach (PMA) for generalized " + << "reliability level " << index + 1 << " = " + << requestedTargetLevel << '\n'; + Real gen_beta_cdf = (cdfFlag) ? + requestedTargetLevel : -requestedTargetLevel; + pmaMaximizeG = (gen_beta_cdf < 0.); // updated in update_pma_maximize() + } + + // Assign cold/warm-start values for initialPtU, mostProbPointX/U, + // computedRespLevel, fnGradX/U, and fnHessX/U. + if (levelCount) + initialize_mpp_search_data(); + +#ifdef DERIV_DEBUG + // numerical verification of analytic Jacobian/Hessian routines + if (mppSearchType == NO_APPROX && levelCount == 0) + mostProbPointU = ranVarMeansU;//mostProbPointX = ranVarMeansX; + //natafTransform.verify_trans_jacobian_hessian(mostProbPointU); + //natafTransform.verify_trans_jacobian_hessian(mostProbPointX); + natafTransform.verify_design_jacobian(mostProbPointU); +#endif // DERIV_DEBUG + + // For AMV+/TANA approximations, iterate until current expansion point + // converges to the MPP. + approxIters = 0; + approxConverged = false; + while (!approxConverged) { + + Sizet2DArray vars_map, primary_resp_map, secondary_resp_map; + BoolDequeArray nonlinear_resp_map(2); + RecastModel* mpp_model_rep = (RecastModel*)mppModel.model_rep(); + if (ria_flag) { // RIA: g is in constraint + primary_resp_map.resize(1); // one objective, no contributors + secondary_resp_map.resize(1); // one constraint, one contributor + secondary_resp_map[0].resize(1); + secondary_resp_map[0][0] = respFnCount; + nonlinear_resp_map[1] = BoolDeque(1, false); + mpp_model_rep->initialize(vars_map, false, NULL, NULL, + primary_resp_map, secondary_resp_map, nonlinear_resp_map, + RIA_objective_eval, RIA_constraint_eval); + } + else { // PMA: g is in objective + primary_resp_map.resize(1); // one objective, one contributor + primary_resp_map[0].resize(1); + primary_resp_map[0][0] = respFnCount; + secondary_resp_map.resize(1); // one constraint, no contributors + nonlinear_resp_map[0] = BoolDeque(1, false); + // If 2nd-order PMA with p-level or generalized beta-level, use + // PMA2_set_mapping() & PMA2_constraint_eval(). For approx-based + // 2nd-order PMA, we utilize curvature of the surrogate (if any) + // to update beta* + if (pma2_flag) + mpp_model_rep->initialize(vars_map, false, NULL, PMA2_set_mapping, + primary_resp_map, secondary_resp_map, nonlinear_resp_map, + PMA_objective_eval, PMA2_constraint_eval); + else + mpp_model_rep->initialize(vars_map, false, NULL, NULL, + primary_resp_map, secondary_resp_map, nonlinear_resp_map, + PMA_objective_eval, PMA_constraint_eval); + } + mppModel.continuous_variables(initialPtU); + + // Execute MPP search and retrieve u-space results + Cout << "\n>>>>> Initiating search for most probable point (MPP)\n"; + ParLevLIter pl_iter + = methodPCIter->mi_parallel_level_iterator(miPLIndex); + mppOptimizer.run(pl_iter); + const Variables& vars_star = mppOptimizer.variables_results(); + const Response& resp_star = mppOptimizer.response_results(); + const RealVector& fns_star = resp_star.function_values(); + Cout << "\nResults of MPP optimization:\nInitial point (u-space) =\n" + << initialPtU << "Final point (u-space) =\n"; + write_data(Cout, vars_star.continuous_variables()); + if (ria_flag) + Cout << "RIA optimum =\n " + << std::setw(write_precision+7) << fns_star[0] << " [u'u]\n" + << " " << std::setw(write_precision+7) + << fns_star[1] << " [G(u) - z]\n"; + else { + Cout << "PMA optimum =\n " + << std::setw(write_precision+7) << fns_star[0] << " ["; + if (pmaMaximizeG) Cout << '-'; + Cout << "G(u)]\n " << std::setw(write_precision+7) + << fns_star[1]; + if (pma2_flag) Cout << " [B* - bar-B*]\n"; + else Cout << " [u'u - B^2]\n"; + } + + // Update MPP search data + update_mpp_search_data(vars_star, resp_star); + + } // end AMV+ while loop + + // Update response/probability/reliability level data + update_level_data(); + + statCount++; + } // end loop over levels + } // end loop over response fns + + // Update warm-start data + if (warmStartFlag && subIteratorFlag) // view->copy + copy_data(iteratedModel.inactive_continuous_variables(), prevICVars); + + // This function manages either component or system reliability metrics + // via post-processing of computed{Resp,Prob,Rel,GenRel}Levels + update_final_statistics(); + + // restore in case of recursion + nondLocRelInstance = prev_instance; +} + + +/** An initial first- or second-order Taylor-series approximation is + required for MV/AMV/AMV+/TANA or for the case where momentStats + (from MV) are required within finalStatistics for subIterator + usage of NonDLocalReliability. */ +void NonDLocalReliability::initial_taylor_series() +{ + bool init_ts_flag = (mppSearchType < NO_APPROX); // updated below + const String& hess_type = iteratedModel.hessian_type(); + size_t i, j, k; + ShortArray asrv(numFunctions, 0); + short mode = 3; + if (taylorOrder == 2 && hess_type != "quasi") // no data yet in quasiHess + mode |= 4; + + const ShortArray& final_asv = finalStatistics.active_set_request_vector(); + switch (mppSearchType) { + case MV: + asrv.assign(numFunctions, mode); + break; + case AMV_X: case AMV_U: + case AMV_PLUS_X: case AMV_PLUS_U: + case TANA_X: case TANA_U: + for (i=0; i>>>> Evaluating response at mean values\n"; + if (mppSearchType && mppSearchType < NO_APPROX) + uSpaceModel.component_parallel_mode(TRUTH_MODEL); + iteratedModel.continuous_variables(natafTransform.x_means()); + activeSet.request_vector(asrv); + iteratedModel.compute_response(activeSet); + const Response& curr_resp = iteratedModel.current_response(); + fnValsMeanX = curr_resp.function_values(); + fnGradsMeanX = curr_resp.function_gradients(); + if (mode & 4) + fnHessiansMeanX = curr_resp.function_hessians(); + + // compute the covariance matrix from the correlation matrix + RealSymMatrix covariance; + const Pecos::RealVector& x_std_devs = natafTransform.x_std_deviations(); + if (correlation_flag) { + covariance.shapeUninitialized(numUncertainVars); + const Pecos::RealSymMatrix& x_corr_mat + = natafTransform.x_correlation_matrix(); + for (i=0; i bad for MV CDF estimates. + bool t2nq = (taylorOrder == 2 && hess_type != "quasi"); // 2nd-order mean + for (i=0; i>>>> Evaluating response at median values\n"; + if (mppSearchType && mppSearchType < NO_APPROX) + uSpaceModel.component_parallel_mode(TRUTH_MODEL); + RealVector ep_median_u(numUncertainVars), // inits vals to 0 + ep_median_x(numUncertainVars, false); + natafTransform.trans_U_to_X(ep_median_u, ep_median_x); + iteratedModel.continuous_variables(ep_median_x); + activeSet.request_values(0); // initialize + for (size_t i=0; iinitialize_random_variables(natafTransform); + } +} + + +/** For a particular response function prior to the first z/p/beta level, + initialize/warm-start optimizer initial guess (initialPtU), + expansion point (mostProbPointX/U), and associated response + data (computedRespLevel, fnGradX/U, and fnHessX/U). */ +void NonDLocalReliability::initialize_level_data() +{ + // All reliability methods need initialization of initialPtU; AMV/AMV+/TANA + // methods additionally need initialization of fnGradX/U; and AMV+/TANA + // methods additionally need initialization of mostProbPointX/U and + // computedRespLevel. + + // If warm-starting across multiple NonDLocalReliability invocations (e.g., + // for modified design parameters in RBDO), warm-start using the level 0 final + // results for the corresponding response fn. For all subsequent levels, + // the warm-start procedure is self-contained (i.e., no data from the + // previous NonDLocalReliability invocation is used). + + // For AMV+ across multiple NonDLocalReliability invocations, the previous + // level 0 converged MPP provides the basis for the initial expansion point. + // If inactive variable design sensitivities are available, a projection + // from the previous MPP is used. In either case, re-evaluation of response + // data is required to capture the effect of inactive variable changes + // (design variables in RBDO). Since the mean expansion at the new d + // has already been computed, one could also use this since it may predict + // an MPP estimate (after one opt cycle, prior to the expense of the second + // expansion evaluation) as good as the converged/projected MPP at the + // old d. However, the former approach has been observed to be preferable + // in practice (even without projection). + + if (warmStartFlag && subIteratorFlag && numRelAnalyses) { + // level 0 of each response fn in subsequent UQ analysis: initial + // optimizer guess and initial expansion point are the converged + // MPP from the previous UQ analysis, for which the computedRespLevel + // and fnGradX/U must be re-evaluated due to design variable changes. + + // simplest approach + initialPtU = prevMPPULev0[respFnCount]; // AMV/AMV+/FORM + + // If inactive var sensitivities are available, then apply a correction + // to initialPtU using a design sensitivity projection (Burton & Hajela). + // Note 1: only valid for RIA. + // Note 2: when the top level RBDO optimizer is performing a value-based + // line search, it is possible for prevFnGradDLev0 to be older than + // prevICVars/prevMPPULev0/prevFnGradULev0. In testing, this appears to + // be OK and preferable to bypassing the projection when prevFnGradDLev0 + // is out of date (which is why the previous ASV test is cumulative: if + // prevFnGradDLev0 has been populated, use it whether or not it was from + // the last analysis). + bool inactive_grads = (prevCumASVLev0[respFnCount] & 2) ? true : false; + bool lev0_ria = (requestedRespLevels[respFnCount].empty()) ? false : true; + if (inactive_grads && lev0_ria) { + RealVector fn_grad_d = Teuchos::getCol(Teuchos::View, prevFnGradDLev0, + respFnCount); + RealVector fn_grad_u = Teuchos::getCol(Teuchos::View, prevFnGradULev0, + respFnCount); + const RealVector& d_k_plus_1 + = iteratedModel.inactive_continuous_variables(); // view + Real grad_d_delta_d = 0., norm_grad_u_sq = 0.; + size_t i, num_icv = d_k_plus_1.length(); + for (i=0; i>>>> Evaluating new response at projected MPP\n"; + else + Cout << "\n>>>>> Evaluating new response at previous MPP\n"; + uSpaceModel.component_parallel_mode(TRUTH_MODEL); + // set active/uncertain vars augmenting inactive design vars + iteratedModel.continuous_variables(mostProbPointX); + short mode = (taylorOrder == 2) ? 7 : 3; + activeSet.request_values(0); activeSet.request_value(mode, respFnCount); + + iteratedModel.compute_response(activeSet); + const Response& curr_resp = iteratedModel.current_response(); + computedRespLevel = curr_resp.function_value(respFnCount); + fnGradX = curr_resp.function_gradient_copy(respFnCount); + + SizetMultiArrayConstView cv_ids = iteratedModel.continuous_variable_ids(); + SizetArray x_dvv; copy_data(cv_ids, x_dvv); + natafTransform.trans_grad_X_to_U(fnGradX, fnGradU, mostProbPointX, + x_dvv, cv_ids); + if (mode & 4) { + fnHessX = curr_resp.function_hessian(respFnCount); + natafTransform.trans_hess_X_to_U(fnHessX, fnHessU, mostProbPointX, + fnGradX, x_dvv, cv_ids); + curvatureDataAvailable = true; kappaUpdated = false; + } + } + } + else { // level 0 of each response fn in first or only UQ analysis + + // initial fnGradX/U for AMV/AMV+ = grads at mean x values, initial + // expansion point for AMV+ = mean x values. + if (mppSearchType < NO_APPROX) { // AMV/AMV+/TANA + // update mostProbPointX/U, computedRespLevel, fnGradX/U, fnHessX/U + assign_mean_data(); +#ifdef MPP_CONVERGE_RATE + if (mppSearchType >= AMV_PLUS_X) + Cout << "u'u = " << mostProbPointU.dot(mostProbPointU) + << " G(u) = " << computedRespLevel << '\n'; +#endif // MPP_CONVERGE_RATE + } + + // initial optimizer guess in u-space (initialPtU) + initialPtU = initialPtUSpec; // initialPtUSpec set in ctor + + /* + // fall back if projection is unavailable (or numerics don't work out). + initialPtU = (ria_flag) ? initialPtUSpec : + std::fabs(requestedCDFRelLevel)/std::sqrt((Real)numUncertainVars); + + // if fnValsMeanX/fnGradU are available, then warm start initialPtU using + // a projection from the means. + if (warmStartFlag && mv_flag) { + Real alpha, norm_grad_u_sq = fnGradU.dot(fnGradU); + if (ria_flag) { + // use same projection idea as for a z level change, + // but project from means + if ( norm_grad_u_sq > 1.e-10 ) { + alpha = (requestedRespLevel - fnValsMeanX[respFnCount]) + / norm_grad_u_sq; + for (i=0; i= 0. && norm_grad_u_sq > 1.e-10) { + Real alpha1 = (-b + std::sqrt(b2m4ac))/2./norm_grad_u_sq, + alpha2 = (-b - std::sqrt(b2m4ac))/2./norm_grad_u_sq, + g_est1 = fnValsMeanX[respFnCount] + alpha1*norm_grad_u_sq; + // Select the correct root based on sign convention involving beta + // and relationship of projected G to G(0): + if (requestedCDFRelLevel >= 0.) + // if beta_cdf >= 0, then projected G should be <= G(0) + alpha = (g_est1 <= medianFnVals[respFnCount]) ? alpha1 : alpha2; + else + // if beta_cdf < 0, then projected G should be > G(0) + alpha = (g_est1 > medianFnVals[respFnCount]) ? alpha1 : alpha2; + for (i=0; i 1.e-10 ) { // also handles NPSOL numerical case + Real alpha = (requestedTargetLevel - + requestedRespLevels[respFnCount][levelCount-1])/norm_grad_u_sq; + for (size_t i=0; i= rl_len + pl_len + bl_len ) ) ? + computedGenRelLevels[respFnCount][levelCount-1] : + computedRelLevels[respFnCount][levelCount-1]; + // Note: scaling is applied to mppU, so we want best est of new beta. + // Don't allow excessive init pt scaling if secant Hessian updating. + Real high_tol = 1.e+3, + low_tol = ( ( taylorOrder == 2 || integrationOrder == 2 ) && + iteratedModel.hessian_type() == "quasi" ) ? 1.e-3 : 1.e-10; + if ( std::abs(prev_bl) > low_tol && std::abs(prev_bl) < high_tol && + std::abs(requestedTargetLevel) > low_tol && + std::abs(requestedTargetLevel) < high_tol ) { + // CDF or CCDF does not matter for scale_factor so long as it is + // consistent (CDF/CDF or CCDF/CCDF). + Real scale_factor = requestedTargetLevel / prev_bl; +#ifdef DEBUG + Cout << "PMA warm start: previous = " << prev_bl + << " current = " << requestedTargetLevel + << " scale_factor = " << scale_factor << std::endl; +#endif // DEBUG + for (size_t i=0; i copy + natafTransform.trans_U_to_X(mostProbPointU, mostProbPointX); + + // Set computedRespLevel to the current g(x) value by either performing + // a validation function evaluation (AMV/AMV+) or retrieving data from + // resp_star (FORM). Also update approximations and convergence tols. + SizetMultiArrayConstView cv_ids = iteratedModel.continuous_variable_ids(); + SizetArray x_dvv; copy_data(cv_ids, x_dvv); + switch (mppSearchType) { + case AMV_X: case AMV_U: { + approxConverged = true; // break out of while loop + uSpaceModel.component_parallel_mode(TRUTH_MODEL); + activeSet.request_values(0); activeSet.request_value(1, respFnCount); + iteratedModel.continuous_variables(mostProbPointX); + iteratedModel.compute_response(activeSet); + computedRespLevel + = iteratedModel.current_response().function_value(respFnCount); + break; + } + case AMV_PLUS_X: case AMV_PLUS_U: case TANA_X: case TANA_U: { + // Assess AMV+/TANA iteration convergence. ||del_u|| is not a perfect + // metric since cycling between MPP estimates can occur. Therefore, + // a maximum number of iterations is also enforced. + //conv_metric = std::fabs(fn_vals[respFnCount] - requestedRespLevel); + ++approxIters; + if (conv_metric < convergenceTol) + approxConverged = true; + else if (approxIters >= maxIterations) { + Cerr << "\nWarning: maximum number of limit state approximation cycles " + << "exceeded.\n"; + warningBits |= 1; // first warning in output summary + approxConverged = true; + } + // Update response data for local/multipoint MPP approximation + short mode = 1; + if (approxConverged) { + Cout << "\n>>>>> Approximate MPP iterations converged. " + << "Evaluating final response.\n"; + // fnGradX/U needed for warm starting by projection, final_stat_grad, + // and/or 2nd-order integration. + const ShortArray& final_asv = finalStatistics.active_set_request_vector(); + if ( warmStartFlag || ( final_asv[statCount] & 2 ) ) + mode |= 2; + if (integrationOrder == 2) { + mode |= 4; + if (numUncertainVars != numNormalVars) + mode |= 2; // fnGradX needed to transform fnHessX to fnHessU + } + } + else { // not converged + Cout << "\n>>>>> Updating approximation for MPP iteration " + << approxIters+1 << "\n"; + mode |= 2; // update AMV+/TANA approximation + if (taylorOrder == 2) // update AMV^2+ approximation + mode |= 4; + if (warmStartFlag) // warm start initialPtU for next AMV+ iteration + initialPtU = mostProbPointU; + } + // evaluate new expansion point + uSpaceModel.component_parallel_mode(TRUTH_MODEL); + activeSet.request_values(0); + activeSet.request_value(mode, respFnCount); + iteratedModel.continuous_variables(mostProbPointX); + iteratedModel.compute_response(activeSet); + const Response& curr_resp = iteratedModel.current_response(); + computedRespLevel = curr_resp.function_value(respFnCount); +#ifdef MPP_CONVERGE_RATE + Cout << "u'u = " << mostProbPointU.dot(mostProbPointU) + << " G(u) = " << computedRespLevel << '\n'; +#endif // MPP_CONVERGE_RATE + if (mode & 2) { + fnGradX = curr_resp.function_gradient_copy(respFnCount); + natafTransform.trans_grad_X_to_U(fnGradX, fnGradU, mostProbPointX, + x_dvv, cv_ids); + } + if (mode & 4) { + fnHessX = curr_resp.function_hessian(respFnCount); + natafTransform.trans_hess_X_to_U(fnHessX, fnHessU, mostProbPointX, + fnGradX, x_dvv, cv_ids); + curvatureDataAvailable = true; kappaUpdated = false; + } + + // Update the limit state surrogate model + update_limit_state_surrogate(); + + // Update pmaMaximizeG if 2nd-order PMA for specified p / beta* level + if ( !approxConverged && !ria_flag && integrationOrder == 2 ) + update_pma_maximize(mostProbPointU, fnGradU, fnHessU); + + break; + } + case NO_APPROX: { // FORM/SORM + + // direct optimization converges to MPP: no new approximation to compute + approxConverged = true; // break out of while loop + if (ria_flag) // RIA computed response = eq_con_star + response target + computedRespLevel = fns_star[1] + requestedTargetLevel; + else // PMA computed response = +/- obj_fn_star + computedRespLevel = (pmaMaximizeG) ? -fns_star[0] : fns_star[0]; + + // fnGradX/U needed for warm starting by projection, final_stat_grad, and/or + // 2nd-order integration (for nonlinear transformations), and should be + // retrievable from previous evals. If second-order integration for RIA, + // fnHessX/U also needed, but not retrievable. If second-order PMA with + // specified p-level, Hessian should be retrievable since it was computed + // during the update of requestedCDFRelLevel from requestedCDFProbLevel. + // When data should be retrievable, we cannot in general assume that the + // last grad/Hessian eval corresponds to the converged MPP; therefore, we + // use a DB search. If the DB search fails (e.g., the eval cache is + // deactivated), then we resort to reevaluation. + short mode = 0, found_mode = 0; // computedRespLevel already retrieved + const ShortArray& final_asv = finalStatistics.active_set_request_vector(); + if ( warmStartFlag || ( final_asv[statCount] & 2 ) ) + mode |= 2; + if ( integrationOrder == 2 ) {// apply 2nd-order integr in all RIA/PMA cases + mode |= 4; + if (numUncertainVars != numNormalVars) + mode |= 2; // fnGradX needed to transform fnHessX to fnHessU + } + + // retrieve previously evaluated gradient information, if possible + if (mode & 2) { // avail in all RIA/PMA cases (exception: numerical grads) + // query data_pairs to retrieve the fn gradient at the MPP + Variables search_vars = iteratedModel.current_variables().copy(); + search_vars.continuous_variables(mostProbPointX); + ActiveSet search_set = resp_star.active_set(); + ShortArray search_asv(numFunctions, 0); + search_asv[respFnCount] = 2; + search_set.request_vector(search_asv); + PRPCacheHIter cache_it = lookup_by_val(data_pairs, + iteratedModel.interface_id(), search_vars, search_set); + if (cache_it != data_pairs.get().end()) { + fnGradX = cache_it->response().function_gradient_copy(respFnCount); + found_mode |= 2; + } + } + // retrieve previously evaluated Hessian information, if possible + // > RIA and std PMA beta-level: Hessian not avail since not yet evaluated + // > PMA p-level and generalized beta-level: Hessian should be available + if ( ( mode & 4 ) && !ria_flag && + ( levelCount < rl_len + pl_len || + levelCount >= rl_len + pl_len + bl_len ) ) { + // query data_pairs to retrieve the fn Hessian at the MPP + Variables search_vars = iteratedModel.current_variables().copy(); + search_vars.continuous_variables(mostProbPointX); + ActiveSet search_set = resp_star.active_set(); + ShortArray search_asv(numFunctions, 0); + search_asv[respFnCount] = 4; + search_set.request_vector(search_asv); + PRPCacheHIter cache_it = lookup_by_val(data_pairs, + iteratedModel.interface_id(), search_vars, search_set); + if (cache_it != data_pairs.get().end()) { + fnHessX = cache_it->response().function_hessian(respFnCount); + found_mode |= 4; + } + } + // evaluate any remaining required data which could not be retrieved + short remaining_mode = mode - found_mode; + if (remaining_mode) { + Cout << "\n>>>>> Evaluating limit state derivatives at MPP\n"; + iteratedModel.continuous_variables(mostProbPointX); + activeSet.request_values(0); + activeSet.request_value(remaining_mode, respFnCount); + iteratedModel.compute_response(activeSet); + const Response& curr_resp = iteratedModel.current_response(); + if (remaining_mode & 2) + fnGradX = curr_resp.function_gradient_copy(respFnCount); + if (remaining_mode & 4) + fnHessX = curr_resp.function_hessian(respFnCount); + } + if (mode & 2) + natafTransform.trans_grad_X_to_U(fnGradX, fnGradU, mostProbPointX, + x_dvv, cv_ids); + if (mode & 4) { + natafTransform.trans_hess_X_to_U(fnHessX, fnHessU, mostProbPointX, + fnGradX, x_dvv, cv_ids); + curvatureDataAvailable = true; kappaUpdated = false; + } + break; + } + } + + // set computedRelLevel using u'u from fns_star; must follow fnGradU update + if (ria_flag) + computedRelLevel = signed_norm(std::sqrt(fns_star[0])); + else if (integrationOrder == 2) { // second-order PMA + // no op: computed{Rel,GenRel}Level updated in PMA2_constraint_eval() + } + else { // first-order PMA + Real norm_u_sq = fns_star[1] + std::pow(requestedTargetLevel, 2); + computedRelLevel = signed_norm(std::sqrt(norm_u_sq)); + } +} + + +/** Updates computedRespLevels/computedProbLevels/computedRelLevels, + finalStatistics, warm start, and graphics data. */ +void NonDLocalReliability::update_level_data() +{ + // local reliability data aren't output to tabular, so send directly + // to graphics window only + Graphics& dakota_graphics = parallelLib.output_manager().graphics(); + + bool ria_flag = (levelCount < requestedRespLevels[respFnCount].length()); + + // Update computed Resp/Prob/Rel/GenRel levels arrays. finalStatistics + // is updated within update_final_statistics() for all resp fns & levels. + computedRespLevels[respFnCount][levelCount] = computedRespLevel; + computedRelLevels[respFnCount][levelCount] = computedRelLevel; + Real computed_prob_level; + if (!ria_flag && integrationOrder == 2) { + computedGenRelLevels[respFnCount][levelCount] = computedGenRelLevel; + computedProbLevels[respFnCount][levelCount] = computed_prob_level = + probability(computedGenRelLevel); + } + else { + computedProbLevels[respFnCount][levelCount] = computed_prob_level = + probability(computedRelLevel, cdfFlag, mostProbPointU, fnGradU, fnHessU); + computedGenRelLevels[respFnCount][levelCount] = computedGenRelLevel = + reliability(computed_prob_level); + } + + // Final statistic gradients are dz/ds, dbeta/ds, or dp/ds + const ShortArray& final_asv = finalStatistics.active_set_request_vector(); + bool system_grad_contrib = false; + if (respLevelTargetReduce && + levelCount < requestedRespLevels[respFnCount].length()) { + size_t sys_stat_count = 2*numFunctions + totalLevelRequests + levelCount; + if (final_asv[sys_stat_count] & 2) + system_grad_contrib = true; + } + if ( (final_asv[statCount] & 2) || system_grad_contrib ) { + + // evaluate dg/ds at the MPP and store in final_stat_grad + RealVector final_stat_grad; + dg_ds_eval(mostProbPointX, fnGradX, final_stat_grad); + + // for warm-starting next run + if (warmStartFlag && subIteratorFlag && levelCount == 0) + Teuchos::setCol(final_stat_grad, respFnCount, prevFnGradDLev0); + + // RIA: sensitivity of beta/p/beta* w.r.t. inactive variables + // dbeta/ds = 1/norm_grad_u * dg/ds (first-order) + // dp/ds = -phi(-beta) * dbeta/ds (first-order) + // dp_2/ds = [Phi(-beta_corr)*sum - phi(-beta_corr)*prod] * dbeta/ds + // (second-order) + // dbeta*/ds = -1/phi(-beta*) * dp_2/ds (second-order) + // PMA: sensitivity of g function w.r.t. inactive variables + // dz/ds = dg/ds + if (ria_flag) { + // beta_cdf = -beta_ccdf, p_cdf = 1. - p_ccdf + // -->> dbeta_cdf/ds = -dbeta_ccdf/ds, dp_cdf/ds = -dp_ccdf/ds + Real norm_grad_u = fnGradU.normFrobenius(); + // factor for first-order dbeta/ds: + Real factor = (cdfFlag) ? 1./norm_grad_u : -1./norm_grad_u; + if (integrationOrder == 2 && respLevelTarget != RELIABILITIES) { + factor *= dp2_dbeta_factor(computedRelLevel, cdfFlag); + // factor for second-order dbeta*/ds + if (respLevelTarget == GEN_RELIABILITIES) + factor *= -1. / Pecos::phi(-computedGenRelLevel); + } + else if (respLevelTarget == PROBABILITIES) // factor for first-order dp/ds + factor *= -Pecos::phi(-computedRelLevel); + + // apply factor: + size_t i, num_final_grad_vars + = finalStatistics.active_set_derivative_vector().size(); + for (i=0; i 1 && respFnCount < numFunctions-1 && + levelCount == requestedRespLevels[respFnCount].length() + + requestedProbLevels[respFnCount].length() + + requestedRelLevels[respFnCount].length() + + requestedGenRelLevels[respFnCount].length() - 1) + dakota_graphics.new_dataset(numFunctions+i); + } + } +} + + +void NonDLocalReliability::update_limit_state_surrogate() +{ + bool x_space = (mppSearchType == AMV_X || mppSearchType == AMV_PLUS_X || + mppSearchType == TANA_X); + + // construct local Variables object + Variables mpp_vars(iteratedModel.current_variables().shared_data()); + if (x_space) mpp_vars.continuous_variables(mostProbPointX); + else mpp_vars.continuous_variables(mostProbPointU); + + // construct Response object + ShortArray asv(numFunctions, 0); + asv[respFnCount] = (taylorOrder == 2) ? 7 : 3; + ActiveSet set;//(numFunctions, numUncertainVars); + set.request_vector(asv); + set.derivative_vector(iteratedModel.continuous_variable_ids()); + Response response(SIMULATION_RESPONSE, set); + response.function_value(computedRespLevel, respFnCount); + if (x_space) { + response.function_gradient(fnGradX, respFnCount); + if (taylorOrder == 2) + response.function_hessian(fnHessX, respFnCount); + } + else { + response.function_gradient(fnGradU, respFnCount); + if (taylorOrder == 2) + response.function_hessian(fnHessU, respFnCount); + } + IntResponsePair response_pr(0, response); // dummy eval id + + // After a design variable change, history data (e.g., TANA) needs + // to be cleared (build_approximation() only calls clear_current()) + if (numRelAnalyses && levelCount == 0) + uSpaceModel.approximations()[respFnCount].clear_all(); + // build the new local/multipoint approximation + uSpaceModel.build_approximation(mpp_vars, response_pr); +} + + +void NonDLocalReliability:: +update_pma_maximize(const RealVector& mpp_u, const RealVector& fn_grad_u, + const RealSymMatrix& fn_hess_u) +{ + Real p_cdf; bool update = false; + size_t rl_len = requestedRespLevels[respFnCount].length(), + rl_pl_len = rl_len + requestedProbLevels[respFnCount].length(), + rl_pl_bl_len = rl_pl_len + requestedRelLevels[respFnCount].length(); + if (levelCount < rl_pl_len) { + Real p = requestedProbLevels[respFnCount][levelCount-rl_len]; + p_cdf = (cdfFlag) ? p : 1. - p; + update = true; + } + else if (levelCount >= rl_pl_bl_len) { + Real gen_beta = requestedGenRelLevels[respFnCount][levelCount-rl_pl_bl_len]; + Real gen_beta_cdf = (cdfFlag) ? gen_beta : -gen_beta; + p_cdf = probability(gen_beta_cdf); + update = true; + } + if (update) { + Real beta_cdf = reliability(p_cdf, true, mpp_u, fn_grad_u, fn_hess_u); + pmaMaximizeG = (beta_cdf < 0.); + } +} + + +void NonDLocalReliability::assign_mean_data() +{ + const Pecos::RealVector& x_means = natafTransform.x_means(); + mostProbPointX = x_means; + mostProbPointU = ranVarMeansU; + computedRespLevel = fnValsMeanX(respFnCount); + for (size_t i=0; i 0.) + // grad_f[i] = u[i]/sqrt_sum_sq; + //else // gradient undefined at origin, use 0. to keep optimizer happy + // grad_f[i] = 0.; +} + + +/** This function recasts a G(u) response set (already transformed and + approximated in other recursions) into an RIA equality constraint. */ +void NonDLocalReliability:: +RIA_constraint_eval(const Variables& sub_model_vars, + const Variables& recast_vars, + const Response& sub_model_response, + Response& recast_response) +{ + // -------------------------------------------------------- + // The RIA equality constraint is G(u) - response level = 0 + // -------------------------------------------------------- + + short asv_val = recast_response.active_set_request_vector()[1]; + int resp_fn = nondLocRelInstance->respFnCount; + if (asv_val & 1) { + const Real& sub_model_fn = sub_model_response.function_value(resp_fn); + recast_response.function_value( + sub_model_fn - nondLocRelInstance->requestedTargetLevel, 1); + } + if (asv_val & 2) // dG/du: no additional transformation needed + recast_response.function_gradient( + sub_model_response.function_gradient_view(resp_fn), 1); + if (asv_val & 4) // d^2G/du^2: no additional transformation needed + recast_response.function_hessian( + sub_model_response.function_hessian(resp_fn), 1); +} + + +/** This function recasts a G(u) response set (already transformed and + approximated in other recursions) into an PMA objective function. */ +void NonDLocalReliability:: +PMA_objective_eval(const Variables& sub_model_vars, + const Variables& recast_vars, + const Response& sub_model_response, + Response& recast_response) +{ + // ---------------------------------- + // The PMA objective function is G(u) + // ---------------------------------- + + int resp_fn = nondLocRelInstance->respFnCount; + short sm_asv_val = sub_model_response.active_set_request_vector()[resp_fn]; + Real fn; RealVector fn_grad_u; RealSymMatrix fn_hess_u; + if (sm_asv_val & 2) + fn_grad_u = sub_model_response.function_gradient_view(resp_fn); + if (sm_asv_val & 4) + fn_hess_u = sub_model_response.function_hessian_view(resp_fn); + + // Due to RecastModel, objective_eval always called before constraint_eval, + // so perform NO_APPROX updates here. + if (nondLocRelInstance->mppSearchType == NO_APPROX && + nondLocRelInstance->integrationOrder == 2) { + nondLocRelInstance->curvatureDataAvailable = true; + nondLocRelInstance->kappaUpdated = false; // new fn_{grad,hess}_u data + nondLocRelInstance->update_pma_maximize(recast_vars.continuous_variables(), + fn_grad_u, fn_hess_u); + } + + short asv_val = recast_response.active_set_request_vector()[0]; + bool pma_max = nondLocRelInstance->pmaMaximizeG; + if (asv_val & 1) { + fn = sub_model_response.function_value(resp_fn); + if (pma_max) recast_response.function_value(-fn, 0); + else recast_response.function_value( fn, 0); + } + if (asv_val & 2) { // dG/du: no additional transformation needed + if (pma_max) { + RealVector recast_grad = recast_response.function_gradient_view(0); + size_t i, num_vars = fn_grad_u.length(); + for (i=0; irequestedTargetLevel, 2); + recast_response.function_value(c, 1); + } + if (asv_val & 2) { + RealVector grad_f = recast_response.function_gradient_view(1); + for (i=0; irespFnCount; + short sm_asv_val = sub_model_response.active_set_request_vector()[resp_fn]; + bool cdf = nondLocRelInstance->cdfFlag; + + // Calculate beta --> p --> beta*. Use up-to-date mpp/grad/Hessian info, + // including surrogate-based data, within signed_norm(), but disallow + // surrogate-based curvature corrections due to their sensitivity. The + // presence of fn_grad_u/fn_hess_u data is enforced in PMA2_set_mapping(). + RealVector fn_grad_u = sub_model_response.function_gradient_view(resp_fn); + Real comp_rel = nondLocRelInstance->computedRelLevel = + nondLocRelInstance->signed_norm(u, fn_grad_u, cdf); + // Don't update curvature correction when nonlinear transformation + // induces additional curvature on top of a low-order approximation. + // Note: if linear transformation or u-space AMV^2+, then Hessian is + // consistent with the previous truth and is constant over the surrogate. + Real computed_prob_level = (nondLocRelInstance->mppSearchType == NO_APPROX) ? + nondLocRelInstance->probability(comp_rel, cdf, u, fn_grad_u, + sub_model_response.function_hessian(resp_fn)) : + nondLocRelInstance->probability(comp_rel, cdf, + nondLocRelInstance->mostProbPointU, nondLocRelInstance->fnGradU, + nondLocRelInstance->fnHessU); + Real comp_gen_rel = nondLocRelInstance->computedGenRelLevel = + nondLocRelInstance->reliability(computed_prob_level); + + if (asv_val & 1) { // calculate the equality constraint: beta* - bar-beta* + Real c = comp_gen_rel - nondLocRelInstance->requestedTargetLevel; +#ifdef DEBUG + Cout << "In PMA2_constraint_eval, beta* = " << comp_gen_rel + << " bar-beta* = " << nondLocRelInstance->requestedTargetLevel + << " eq constr = " << c << std::endl; +#endif + recast_response.function_value(c, 1); + } + if (asv_val & 2) { + // Note: for second-order integrations, beta* is a function of p and + // kappa(u). dbeta*/du involves dkappa/du, but these terms are neglected + // as in dbeta*/ds (design sensitivities). + // dbeta/du_i = u_i/beta (in factor below) + // dp_2/du_i = [Phi(-beta_corr)*sum - phi(-beta_corr)*prod] * dbeta/du_i + // (term in brackets computed in dp2_dbeta_factor()) + // dbeta*/du_i = -1/phi(-beta*) * dp_2/du (in factor below) + Real factor = -nondLocRelInstance->dp2_dbeta_factor(comp_rel, cdf) + / comp_rel / Pecos::phi(-comp_gen_rel); + size_t i, num_vars = u.length(); + RealVector grad_f = recast_response.function_gradient_view(1); + for (i=0; ip-->beta* calcs + int sm_index = nondLocRelInstance->respFnCount; + short sub_model_request = sub_model_set.request_value(sm_index); + + // all cases require latest fn_grad_u (either truth-based or approx-based) + sub_model_request |= 2; + // PMA SORM requires latest fn_hess_u (truth-based) + if (nondLocRelInstance->mppSearchType == NO_APPROX) + sub_model_request |= 4; + // else value/grad request utilizes most recent truth fnGradU/fnHessU + + sub_model_set.request_value(sub_model_request, sm_index); + } +} + + +/** Computes dg/ds where s = design variables. Supports potentially + overlapping cases of design variable augmentation and insertion. */ +void NonDLocalReliability:: +dg_ds_eval(const RealVector& x_vars, const RealVector& fn_grad_x, + RealVector& final_stat_grad) +{ + const SizetArray& final_dvv = finalStatistics.active_set_derivative_vector(); + size_t i, num_final_grad_vars = final_dvv.size(); + if (final_stat_grad.empty()) + final_stat_grad.resize(num_final_grad_vars); + + // For design vars that are distribution parameters of the uncertain vars, + // dg/ds = dg/dx * dx/ds where dx/ds is the design Jacobian. Since dg/dx is + // already available (passed in as fn_grad_x), these sensitivities do not + // require additional response evaluations. + bool dist_param_deriv = false; + size_t num_outer_cv = secondaryACVarMapTargets.size(); + for (i=0; i>>>> Evaluating sensitivity with respect to augmented inactive " + << "variables\n"; + if (mppSearchType && mppSearchType < NO_APPROX) + uSpaceModel.component_parallel_mode(TRUTH_MODEL); + iteratedModel.continuous_variables(x_vars); + ActiveSet inactive_grad_set = activeSet; + inactive_grad_set.request_values(0); + inactive_grad_set.request_value(2, respFnCount); + // final_dvv is mapped from the top-level DVV in NestedModel::set_mapping() + // and includes augmented and inserted variable ids. Since we only want the + // augmented ids in this case, the UQ-level inactive ids are sufficient. + SizetMultiArrayConstView icv_ids + = iteratedModel.inactive_continuous_variable_ids(); + inactive_grad_set.derivative_vector(icv_ids); + /* More rigorous with reqd deriv vars, but equivalent in practice: + // Filter final_dvv to contain only inactive continuous variable ids: + SizetArray filtered_final_dvv; + for (i=0; imedian: CDF p(g<=z)>0.5, CDF beta<0, CCDF p(g>z)<0.5, CCDF beta>0 + // z0, CCDF p(g>z)>0.5, CCDF beta<0 + // z=median: CDF p(g<=z) = CCDF p(g>z) = 0.5, CDF beta = CCDF beta = 0 + //Real beta_cdf = (computedRespLevel > medianFnVals[respFnCount]) + // ? -std::sqrt(norm_u_sq) : std::sqrt(norm_u_sq); + + // This approach avoids the need to evaluate medianFnVals. Thanks to + // Barron Bichon for suggesting it. + // if > 0, then G is increasing along u and G(u*) > G(0) + // if < 0, then G is decreasing along u and G(u*) < G(0) + Real beta_cdf = (mpp_u.dot(fn_grad_u) > 0.) ? -norm_mpp_u : norm_mpp_u; +#ifdef DEBUG + Cout << "\nSign of is "; + if (mpp_u.dot(fn_grad_u) > 0.) Cout << " 1.\n\n"; + else Cout << "-1.\n\n"; +#endif + return (cdf_flag) ? beta_cdf : -beta_cdf; +} + + +/** Converts beta into a probability using either first-order (FORM) or + second-order (SORM) integration. The SORM calculation first calculates + the principal curvatures at the MPP (using the approach in Ch. 8 of + Haldar & Mahadevan), and then applies correction formulations from the + literature (Breitung, Hohenbichler-Rackwitz, or Hong). */ +Real NonDLocalReliability:: +probability(Real beta, bool cdf_flag, const RealVector& mpp_u, + const RealVector& fn_grad_u, const RealSymMatrix& fn_hess_u) +{ + Real p = probability(beta); // FORM approximation + int wpp7; + if (outputLevel > NORMAL_OUTPUT) { + wpp7 = write_precision+7; + Cout << "Probability:"// << " beta = " << beta + << " first-order = " << std::setw(wpp7) << p; + } + + if (integrationOrder == 2 && curvatureDataAvailable) { + + if (!kappaUpdated) { + principal_curvatures(mpp_u, fn_grad_u, fn_hess_u, kappaU); + kappaUpdated = true; + } + + // The correction to p is applied for beta >= 0 (FORM p <= 0.5). + // For beta < 0, apply correction to complementary problem (Tvedt 1990). + // > beta changes sign + // > p becomes complement + // > principal curvature sign convention defined for CDF beta > 0 + // (negate for CDF beta < 0 or CCDF beta > 0, OK for CCDF beta < 0) + Real beta_corr = std::abs(beta); + Real p_corr = (beta >= 0.) ? p : 1. - p; + RealVector kappa; scale_curvature(beta, cdf_flag, kappaU, kappa); + + // Test for numerical exceptions in sqrt. Problematic kappa are large and + // negative (kterm is always positive). Skipping individual kappa means + // neglecting a primary curvature and including secondary curvatures, which + // may be counter-productive (potentially less accurate than FORM). + // Therefore, the entire correction is skipped if any curvature is + // problematic. A consistent approach must be used in reliability(). + bool apply_correction = true; + Real psi_m_beta; + if (secondOrderIntType != BREITUNG) + psi_m_beta = Pecos::phi(-beta_corr) / Pecos::Phi(-beta_corr); + Real kterm = (secondOrderIntType == BREITUNG) ? beta_corr : psi_m_beta; + int i, num_kappa = numUncertainVars - 1; + for (i=0; i + initialize(mpp_u, x_data_flag, respFnCount, p, requestedTargetLevel); + ParLevLIter pl_iter = methodPCIter->mi_parallel_level_iterator(miPLIndex); + importanceSampler.run(pl_iter); + p = importance_sampler_rep->final_probability(); + if (outputLevel > NORMAL_OUTPUT) + Cout << " refined = " << std::setw(wpp7) << p; + } + if (outputLevel > NORMAL_OUTPUT) + Cout << '\n'; +#ifdef DEBUG + if (integrationOrder == 2 && curvatureDataAvailable) + { Cout << "In probability(), kappaU:\n"; write_data(Cout, kappaU); } +#endif + + return p; +} + + +/** Compute sensitivity of second-order probability w.r.t. beta for use + in derivatives of p_2 or beta* w.r.t. auxilliary parameters s (design, + epistemic) or derivatives of beta* w.r.t. u in PMA2_constraint_eval(). */ +Real NonDLocalReliability::dp2_dbeta_factor(Real beta, bool cdf_flag) +{ + // dp/ds = -phi(-beta) * dbeta/ds + // (fall back to first-order, if needed) + // dp_2/ds = [Phi(-beta_corr)*sum - phi(-beta_corr)*prod] * dbeta/ds + // (this function computes term in brackets) + // dbeta*/ds = -1/phi(-beta*) * dp_2/ds (second-order) + + // For beta < 0, beta_corr = -beta and p_corr = 1 - p: + // dp/ds = -dp_corr/ds = -(dp_corr/dbeta_corr * dbeta_corr/ds) + // = -(dp_corr/dbeta_corr * -dbeta/ds) + // = dp_corr/dbeta_corr * dbeta/ds + + bool apply_correction; size_t i, j, num_kappa; + Real kterm, dpsi_m_beta_dbeta, beta_corr; RealVector kappa; + if (curvatureDataAvailable) { + + //if (!kappaUpdated) { // should already be up to date + // principal_curvatures(mpp_u, fn_grad_u, fn_hess_u, kappaU); + // kappaUpdated = true; + //} + + scale_curvature(beta, cdf_flag, kappaU, kappa); + beta_corr = (beta >= 0.) ? beta : -beta; + + switch (secondOrderIntType) { + case HONG: // addtnl complexity not warranted + Cerr << "\nError: final statistic gradients not implemented for Hong." + << std::endl; + abort_handler(-1); break; + case BREITUNG: + kterm = beta_corr; break; + case HOHENRACK: + // Psi(beta) = phi(beta) / Phi(beta) + // dPsi/dbeta = (Phi dphi/dbeta - phi^2)/Phi^2 + // where dphi/dbeta = -beta phi + // dPsi/dbeta = -phi (beta Phi + phi) / Phi^2 + // = -Psi (beta + Psi) + // --> dPsi/dbeta(-beta_corr) + // = -Psi(-beta_corr) (-beta_corr + Psi(-beta_corr) ) + // = Psi(-beta_corr) ( beta_corr - Psi(-beta_corr) ) + kterm = Pecos::phi(-beta_corr) / Pecos::Phi(-beta_corr); // psi_m_beta + dpsi_m_beta_dbeta = kterm*(beta_corr - kterm); // orig (kterm + beta_corr) + break; + } + + num_kappa = numUncertainVars - 1; + apply_correction = true; + for (i=0; i= 0. && p2_corr <= 1.) // factor for second-order dp/ds: + return p1_corr * sum - Pecos::phi(-beta_corr) * prod2; + } + + // if not returned, then there was an exception + Cerr << "\nWarning: second-order probability sensitivity bypassed.\n"; + warningBits |= 2; // second warning in output summary + } + + return -Pecos::phi(-beta); +} + + +// Converts a probability into a reliability using the inverse of the +// first-order or second-order integrations implemented in +// NonDLocalReliability::probability(). +Real NonDLocalReliability:: +reliability(Real p, bool cdf_flag, const RealVector& mpp_u, + const RealVector& fn_grad_u, const RealSymMatrix& fn_hess_u) +{ + Real beta = reliability(p); // FORM approximation + + if (integrationOrder == 2 && curvatureDataAvailable) { + + if (!kappaUpdated) { + principal_curvatures(mpp_u, fn_grad_u, fn_hess_u, kappaU); + kappaUpdated = true; + } + + // NOTE: these conversions are currently done once. It may be necessary + // to redo them for each beta estimate (when inverting near beta = zero). + Real beta_corr = (beta >= 0.) ? beta : -beta; + Real p_corr = (beta >= 0.) ? p : 1. - p; + RealVector kappa; scale_curvature(beta, cdf_flag, kappaU, kappa); + + // SORM correction to FORM: direct inversion of the SORM formulas is + // infeasible due to the multiple instances of beta on the RHS, even for + // the simplest case (Breitung). Therefore, use Newton's method to solve + // for beta(p) using Phi_inverse() as an initial guess. + // > Newton's method uses reliability_residual() to compute the residual f + // and reliability_residual_derivative() to compute df/dbeta. + // > Newton step is then beta -= f(beta)/[df/dbeta(beta)]. + // > Other options include using an inexact df/dbeta = phi(-beta) from + // FORM or using a quasi-Newton (Broyden update) or FD Newton approach. + + // evaluate residual + Real res; + bool terminate = reliability_residual(p_corr, beta_corr, kappa, res); + + size_t newton_iters = 0, max_iters = 20; // usually converges in ~3 iters + bool converged = false; + while (!terminate && !converged) { + + // evaluate derivative of residual w.r.t. beta + Real dres_dbeta + = reliability_residual_derivative(p_corr, beta_corr, kappa); + + // compute Newton step + Real delta_beta; + if (std::fabs(dres_dbeta) > DBL_MIN) { + delta_beta = -res/dres_dbeta; // full Newton step + // assess convergence using delta_beta, rather than residual, + // since this should be better scaled. + if (std::fabs(delta_beta) < convergenceTol) + converged = true; // but go ahead and take the step, if beneficial + } + else + terminate = true; + + // Simple backtracking line search globalization + bool reduction = false; + size_t backtrack_iters = 0; + while (!reduction && !terminate) { // enter loop even if converged + Real beta_step = beta_corr + delta_beta; + + // verify that new beta_step doesn't violate safeguards. If not, + // evaluate residual res_step at beta_step. + Real res_step; + terminate = reliability_residual(p_corr, beta_step, kappa, res_step); + + if (!terminate) { + if ( std::fabs(res_step) < std::fabs(res) ) { // accept step + reduction = true; + beta_corr = beta_step; + res = res_step; + //Cout << "residual = " << res << " delta = " << delta_beta + // << " beta = " << beta_corr <<'\n'; + } + else if (converged) + terminate = true; // kick out of inner while + else { // backtrack + //Cout << "Backtracking\n"; + delta_beta /= 2.; // halve the step + if (backtrack_iters++ >= max_iters) {// backtrack iter must complete + Cerr << "\nWarning: maximum back-tracking iterations exceeded in " + << "second-order reliability inversion.\n"; + warningBits |= 4; // third warning in output summary + terminate = true; + } + } + } + } + if (++newton_iters >= max_iters && !converged) { // Newton iter completed + Cerr << "\nWarning: maximum Newton iterations exceeded in second-order " + << "reliability inversion.\n"; + warningBits |= 8; // fourth warning in output summary + terminate = true; + } + } + return (beta >= 0.) ? beta_corr : -beta_corr; + } + return beta; +} + + +bool NonDLocalReliability:: +reliability_residual(const Real& p, const Real& beta, + const RealVector& kappa, Real& res) +{ + int i, num_kappa = numUncertainVars - 1; + + // Test for numerical exceptions in sqrt. Problematic kappa are large and + // negative (kterm is always positive). Skipping individual kappa means + // neglecting a primary curvature and including secondary curvatures, which + // may be counter-productive (potentially less accurate than FORM). Since + // the Newton solve can be problematic on its own, skip the entire solve in + // this case. + Real psi_m_beta; + if (secondOrderIntType != BREITUNG) + psi_m_beta = Pecos::phi(-beta) / Pecos::Phi(-beta); + Real kterm = (secondOrderIntType == BREITUNG) ? beta : psi_m_beta; + for (i=0; i DBL_MIN) + for (i=0; i DBL_MIN) { + // Can match the sign of fn_grad_u[i]/norm_grad_u in PMA case (align for + // max G, oppose for min G), but can't in general in RIA case (vectors + // may align or oppose). Fortunately, the R0 sign does not appear to + // matter since R is applied twice in R fn_hess_u R^T. + bool pma_max = (levelCount >= requestedRespLevels[respFnCount].length() && + pmaMaximizeG) ? true : false; + for (i=0; i=0; i--) { // update the ith row vector + for (j=i+1; j principal curvatures + Teuchos::LAPACK la; + int info, lwork = 3*num_kappa - 1; + double* work = new double [lwork]; + // LAPACK eigenvalue solution for real, symmetric A + if (kappa_u.length() != num_kappa) + kappa_u.sizeUninitialized(num_kappa); + la.SYEV('N', A.UPLO(), num_kappa, A.values(), A.stride(), kappa_u.values(), + work, lwork, &info); + delete [] work; + if (info) { + Cerr << "\nError: internal error in LAPACK eigenvalue routine." + << std::endl; + abort_handler(-1); + } + //Cout << "\nkappa_u:" << kappa_u; +} + + +void NonDLocalReliability::print_results(std::ostream& s) +{ + size_t i, j, width = write_precision+7; + StringMultiArrayConstView uv_labels + = iteratedModel.continuous_variable_labels(); + const StringArray& fn_labels = iteratedModel.response_labels(); + s << "-----------------------------------------------------------------\n"; + + if (warningBits) { + s << "Warnings accumulated during solution for one or more levels:\n"; + if (warningBits & 1) + s << " Maximum number of limit state approximation cycles exceeded.\n"; + if (warningBits & 2) + s << " Second-order probability integration bypassed due to numerical " + << "issues.\n"; + if (warningBits & 4) + s << " Maximum back-tracking iterations exceeded in second-order " + << "reliability inversion.\n"; + if (warningBits & 8) + s << " Maximum Newton iterations exceeded in second-order reliability " + << "inversion.\n"; + s << "Please interpret results with care.\n"; + s << "-----------------------------------------------------------------\n"; + } + + for (i=0; i + +#include + +static const char rcsId[]="@(#) $Id: NonDSampling.cpp 7036 2010-10-22 23:20:24Z mseldre $"; + + +namespace Dakota { + + +/** This constructor is called for a standard letter-envelope iterator + instantiation. In this case, set_db_list_nodes has been called and + probDescDB can be queried for settings from the method specification. */ +NonDSampling::NonDSampling(ProblemDescDB& problem_db, Model& model): + NonD(problem_db, model), seedSpec(probDescDB.get_int("method.random_seed")), + randomSeed(seedSpec), samplesSpec(probDescDB.get_int("method.samples")), + samplesRef(samplesSpec), numSamples(samplesSpec), + rngName(probDescDB.get_string("method.random_number_generator")), + sampleType(probDescDB.get_ushort("method.sample_type")), + statsFlag(true), allDataFlag(false), samplingVarsMode(ACTIVE), + sampleRanksMode(IGNORE_RANKS), + varyPattern(!probDescDB.get_bool("method.fixed_seed")), + backfillFlag(probDescDB.get_bool("method.backfill")), + numLHSRuns(0) +{ + if (epistemicStats && totalLevelRequests) { + Cerr << "\nError: sampling does not support level requests for " + << "analyses containing epistemic uncertainties." << std::endl; + abort_handler(-1); + } + + // Since the sampleType is shared with other iterators for other purposes, + // its default in DataMethod.cpp is SUBMETHOD_DEFAULT (0). Enforce an LHS + // default here. + if (!sampleType) + sampleType = SUBMETHOD_LHS; + + // initialize finalStatistics using the default statistics set + initialize_final_statistics(); + + // update concurrency + if (numSamples) // samples is optional (default = 0) + maxEvalConcurrency *= numSamples; +} + + +/** This alternate constructor is used for generation and evaluation + of on-the-fly sample sets. */ +NonDSampling:: +NonDSampling(unsigned short method_name, Model& model, + unsigned short sample_type, int samples, int seed, + const String& rng, bool vary_pattern, short sampling_vars_mode): + NonD(method_name, model), seedSpec(seed), randomSeed(seed), + samplesSpec(samples), samplesRef(samples), numSamples(samples), rngName(rng), + sampleType(sample_type), statsFlag(false), allDataFlag(true), + samplingVarsMode(sampling_vars_mode), sampleRanksMode(IGNORE_RANKS), + varyPattern(vary_pattern), backfillFlag(false), numLHSRuns(0) +{ + subIteratorFlag = true; // suppress some output + + // override default epistemicStats setting from NonD ctor + bool aleatory_mode = (samplingVarsMode == ALEATORY_UNCERTAIN || + samplingVarsMode == ALEATORY_UNCERTAIN_UNIFORM); + epistemicStats = (numEpistemicUncVars && !aleatory_mode); + + // enforce LHS as default sample type + if (!sampleType) + sampleType = SUBMETHOD_LHS; + + // not used but included for completeness + if (numSamples) // samples is optional (default = 0) + maxEvalConcurrency *= numSamples; +} + + +/** This alternate constructor is used by ConcurrentStrategy for + generation of uniform, uncorrelated sample sets. */ +NonDSampling:: +NonDSampling(unsigned short sample_type, int samples, int seed, + const String& rng, const RealVector& lower_bnds, + const RealVector& upper_bnds): + NonD(RANDOM_SAMPLING, lower_bnds, upper_bnds), seedSpec(seed), + randomSeed(seed), samplesSpec(samples), samplesRef(samples), + numSamples(samples), rngName(rng), sampleType(sample_type), statsFlag(false), + allDataFlag(true), samplingVarsMode(ACTIVE_UNIFORM), + sampleRanksMode(IGNORE_RANKS), varyPattern(true), backfillFlag(false), + numLHSRuns(0) +{ + subIteratorFlag = true; // suppress some output + + // enforce LHS as default sample type + if (!sampleType) + sampleType = SUBMETHOD_LHS; + + // not used but included for completeness + if (numSamples) // samples is optional (default = 0) + maxEvalConcurrency *= numSamples; +} + + +NonDSampling::~NonDSampling() +{ } + + +/** This version of get_parameter_sets() extracts data from the + user-defined model in any of the four sampling modes. */ +void NonDSampling::get_parameter_sets(Model& model) +{ + initialize_lhs(true); + + short model_view = model.current_variables().view().first; + switch (samplingVarsMode) { + case ACTIVE_UNIFORM: case ALL_UNIFORM: case UNCERTAIN_UNIFORM: + case ALEATORY_UNCERTAIN_UNIFORM: case EPISTEMIC_UNCERTAIN_UNIFORM: + // Use LHSDriver::generate_uniform_samples() between lower/upper bounds + if ( samplingVarsMode == ACTIVE_UNIFORM || + ( samplingVarsMode == ALL_UNIFORM && + ( model_view == RELAXED_ALL || model_view == MIXED_ALL ) ) || + ( samplingVarsMode == UNCERTAIN_UNIFORM && + ( model_view == RELAXED_UNCERTAIN || + model_view == MIXED_UNCERTAIN ) ) || + ( samplingVarsMode == ALEATORY_UNCERTAIN_UNIFORM && + ( model_view == RELAXED_ALEATORY_UNCERTAIN || + model_view == MIXED_ALEATORY_UNCERTAIN ) ) || + ( samplingVarsMode == EPISTEMIC_UNCERTAIN_UNIFORM && + ( model_view == RELAXED_EPISTEMIC_UNCERTAIN || + model_view == MIXED_EPISTEMIC_UNCERTAIN ) ) ) { + // sample uniformly from ACTIVE lower/upper bounds (regardless of model + // view), from UNCERTAIN lower/upper bounds (with model in DISTINCT view), + // or from ALL lower/upper bounds (with model in ALL view). + // loss of sampleRanks control is OK since NonDIncremLHS uses ACTIVE mode. + // TO DO: add support for uniform discrete + lhsDriver.generate_uniform_samples(model.continuous_lower_bounds(), + model.continuous_upper_bounds(), + numSamples, allSamples, backfillFlag); + } + else if (samplingVarsMode == ALL_UNIFORM) { + // sample uniformly from ALL lower/upper bnds with model in distinct view. + // loss of sampleRanks control is OK since NonDIncremLHS uses ACTIVE mode. + // TO DO: add support for uniform discrete + lhsDriver.generate_uniform_samples(model.all_continuous_lower_bounds(), + model.all_continuous_upper_bounds(), + numSamples, allSamples, backfillFlag); + } + else { // A, E, A+E UNCERTAIN + // sample uniformly from {A,E,A+E} UNCERTAIN lower/upper bounds + // with model using a non-corresponding view (corresponding views + // handled in first case above) + size_t start_acv, num_acv, dummy; + mode_counts(model, start_acv, num_acv, dummy, dummy, dummy, dummy, + dummy, dummy); + if (!num_acv) { + Cerr << "Error: no active continuous variables for sampling in " + << "uniform mode" << std::endl; + abort_handler(-1); + } + const RealVector& all_c_l_bnds = model.all_continuous_lower_bounds(); + const RealVector& all_c_u_bnds = model.all_continuous_upper_bounds(); + RealVector uncertain_c_l_bnds(Teuchos::View, + const_cast(&all_c_l_bnds[start_acv]), num_acv); + RealVector uncertain_c_u_bnds(Teuchos::View, + const_cast(&all_c_u_bnds[start_acv]), num_acv); + // loss of sampleRanks control is OK since NonDIncremLHS uses ACTIVE mode + // TO DO: add support for uniform discrete + lhsDriver.generate_uniform_samples(uncertain_c_l_bnds, + uncertain_c_u_bnds, + numSamples, allSamples, backfillFlag); + } + break; + case ALEATORY_UNCERTAIN: + { + lhsDriver.generate_samples(model.aleatory_distribution_parameters(), + numSamples, allSamples, backfillFlag); + break; + } + case EPISTEMIC_UNCERTAIN: + { + lhsDriver.generate_samples(model.epistemic_distribution_parameters(), + numSamples, allSamples, backfillFlag); + break; + } + case UNCERTAIN: + { + lhsDriver.generate_samples(model.aleatory_distribution_parameters(), + model.epistemic_distribution_parameters(), + numSamples, allSamples, backfillFlag); + break; + } + case ACTIVE: case ALL: { + // extract design and state bounds + RealVector cdv_l_bnds, cdv_u_bnds, csv_l_bnds, csv_u_bnds; + IntVector ddriv_l_bnds, ddriv_u_bnds, dsriv_l_bnds, dsriv_u_bnds; + const RealVector& all_c_l_bnds = model.all_continuous_lower_bounds(); + const RealVector& all_c_u_bnds = model.all_continuous_upper_bounds(); + if (numContDesVars) { + cdv_l_bnds + = RealVector(Teuchos::View, all_c_l_bnds.values(), numContDesVars); + cdv_u_bnds + = RealVector(Teuchos::View, all_c_u_bnds.values(), numContDesVars); + } + if (numContStateVars) { + size_t cv_start = model.acv() - numContStateVars; + csv_l_bnds = RealVector(Teuchos::View, + const_cast(&all_c_l_bnds[cv_start]), numContStateVars); + csv_u_bnds = RealVector(Teuchos::View, + const_cast(&all_c_u_bnds[cv_start]), numContStateVars); + } + const IntVector& all_di_l_bnds = model.all_discrete_int_lower_bounds(); + const IntVector& all_di_u_bnds = model.all_discrete_int_upper_bounds(); + size_t num_ddriv = (numDiscIntDesVars) ? + numDiscIntDesVars - model.discrete_design_set_int_values().size() : 0; + if (num_ddriv) { + ddriv_l_bnds = IntVector(Teuchos::View, all_di_l_bnds.values(),num_ddriv); + ddriv_u_bnds = IntVector(Teuchos::View, all_di_u_bnds.values(),num_ddriv); + } + size_t num_dsriv = (numDiscIntStateVars) ? + numDiscIntStateVars - model.discrete_state_set_int_values().size() : 0; + if (num_dsriv) { + size_t di_start = model.adiv() - numDiscIntStateVars; + dsriv_l_bnds = IntVector(Teuchos::View, + const_cast(&all_di_l_bnds[di_start]), num_dsriv); + dsriv_u_bnds = IntVector(Teuchos::View, + const_cast(&all_di_u_bnds[di_start]), num_dsriv); + } + IntSetArray empty_isa; StringSetArray empty_ssa; RealSetArray empty_rsa; + const IntSetArray& di_design_sets = (numDiscIntDesVars) ? + model.discrete_design_set_int_values() : empty_isa; + const StringSetArray& ds_design_sets = (numDiscStringDesVars) ? + model.discrete_design_set_string_values() : empty_ssa; + const RealSetArray& dr_design_sets = (numDiscRealDesVars) ? + model.discrete_design_set_real_values() : empty_rsa; + const IntSetArray& di_state_sets = (numDiscIntStateVars) ? + model.discrete_state_set_int_values() : empty_isa; + const StringSetArray& ds_state_sets = (numDiscStringStateVars) ? + model.discrete_state_set_string_values() : empty_ssa; + const RealSetArray& dr_state_sets = (numDiscRealStateVars) ? + model.discrete_state_set_real_values() : empty_rsa; + + // Call LHS to generate the specified samples within the specified + // distributions. Use model distribution parameters unless ACTIVE + // excludes {aleatory,epistemic,both} uncertain variables. + if ( samplingVarsMode == ACTIVE && + ( model_view == RELAXED_DESIGN || model_view == RELAXED_STATE || + model_view == MIXED_DESIGN || model_view == MIXED_STATE ) ) { + Pecos::AleatoryDistParams empty_adp; Pecos::EpistemicDistParams empty_edp; + if ( !backfillFlag ) + lhsDriver.generate_samples(cdv_l_bnds, cdv_u_bnds, ddriv_l_bnds, + ddriv_u_bnds, di_design_sets, ds_design_sets, dr_design_sets, + csv_l_bnds, csv_u_bnds, dsriv_l_bnds, dsriv_u_bnds, di_state_sets, + ds_state_sets, dr_state_sets, empty_adp, empty_edp, numSamples, + allSamples, sampleRanks); + else + lhsDriver.generate_unique_samples(cdv_l_bnds, cdv_u_bnds, ddriv_l_bnds, + ddriv_u_bnds, di_design_sets, ds_design_sets, dr_design_sets, + csv_l_bnds, csv_u_bnds, dsriv_l_bnds, dsriv_u_bnds, di_state_sets, + ds_state_sets, dr_state_sets, empty_adp, empty_edp, numSamples, + allSamples, sampleRanks); + } + else if ( samplingVarsMode == ACTIVE && + ( model_view == RELAXED_ALEATORY_UNCERTAIN || + model_view == MIXED_ALEATORY_UNCERTAIN ) ) { + Pecos::EpistemicDistParams empty_edp; + if ( !backfillFlag ) + lhsDriver.generate_samples(cdv_l_bnds, cdv_u_bnds, ddriv_l_bnds, + ddriv_u_bnds, di_design_sets, ds_design_sets, dr_design_sets, + csv_l_bnds, csv_u_bnds, dsriv_l_bnds, dsriv_u_bnds, di_state_sets, + ds_state_sets, dr_state_sets, model.aleatory_distribution_parameters(), + empty_edp, numSamples, allSamples, sampleRanks); + else + lhsDriver.generate_unique_samples(cdv_l_bnds, cdv_u_bnds, ddriv_l_bnds, + ddriv_u_bnds, di_design_sets, ds_design_sets, dr_design_sets, + csv_l_bnds, csv_u_bnds, dsriv_l_bnds, dsriv_u_bnds, di_state_sets, + ds_state_sets, dr_state_sets, model.aleatory_distribution_parameters(), + empty_edp, numSamples, allSamples, sampleRanks); + } + else if ( samplingVarsMode == ACTIVE && + ( model_view == RELAXED_EPISTEMIC_UNCERTAIN || + model_view == MIXED_EPISTEMIC_UNCERTAIN ) ) { + Pecos::AleatoryDistParams empty_adp; + if ( !backfillFlag ) + lhsDriver.generate_samples(cdv_l_bnds, cdv_u_bnds, ddriv_l_bnds, + ddriv_u_bnds, di_design_sets, ds_design_sets, dr_design_sets, + csv_l_bnds, csv_u_bnds, dsriv_l_bnds, dsriv_u_bnds, di_state_sets, + ds_state_sets, dr_state_sets, empty_adp, + model.epistemic_distribution_parameters(), numSamples, allSamples, + sampleRanks); + else + lhsDriver.generate_unique_samples(cdv_l_bnds, cdv_u_bnds, ddriv_l_bnds, + ddriv_u_bnds, di_design_sets, ds_design_sets, dr_design_sets, + csv_l_bnds, csv_u_bnds, dsriv_l_bnds, dsriv_u_bnds, di_state_sets, + ds_state_sets, dr_state_sets, empty_adp, + model.epistemic_distribution_parameters(), numSamples, allSamples, + sampleRanks); + } + else + { + if ( !backfillFlag ) + lhsDriver.generate_samples(cdv_l_bnds, cdv_u_bnds, ddriv_l_bnds, + ddriv_u_bnds, di_design_sets, ds_design_sets, dr_design_sets, + csv_l_bnds, csv_u_bnds, dsriv_l_bnds, dsriv_u_bnds, di_state_sets, + ds_state_sets, dr_state_sets, model.aleatory_distribution_parameters(), + model.epistemic_distribution_parameters(), numSamples, allSamples, + sampleRanks); + else + lhsDriver.generate_unique_samples(cdv_l_bnds, cdv_u_bnds, ddriv_l_bnds, + ddriv_u_bnds, di_design_sets, ds_design_sets, dr_design_sets, + csv_l_bnds, csv_u_bnds, dsriv_l_bnds, dsriv_u_bnds, di_state_sets, + ds_state_sets, dr_state_sets, model.aleatory_distribution_parameters(), + model.epistemic_distribution_parameters(), numSamples, allSamples, + sampleRanks); + // warning sampleRanks will empty. + // See comment in lhs_driver.cpp generate_unique_samples() + } + break; + } + } +} + + +/** This version of get_parameter_sets() does not extract data from the + user-defined model, but instead relies on the incoming bounded region + definition. It only support a UNIFORM sampling mode, where the + distinction of ACTIVE_UNIFORM vs. ALL_UNIFORM is handled elsewhere. */ +void NonDSampling:: +get_parameter_sets(const RealVector& lower_bnds, + const RealVector& upper_bnds) +{ + initialize_lhs(true); + lhsDriver.generate_uniform_samples(lower_bnds, upper_bnds, + numSamples, allSamples); +} + + +void NonDSampling:: +update_model_from_sample(Model& model, const Real* sample_vars) +{ + size_t i, cntr = 0, cv_start, num_cv, div_start, num_div, dsv_start, num_dsv, + drv_start, num_drv; + mode_counts(model, cv_start, num_cv, div_start, num_div, dsv_start, num_dsv, + drv_start, num_drv); + + // sampled continuous vars (by value) + size_t end = cv_start + num_cv; + for (i=cv_start; i= RELAXED_DESIGN && active_view <= RELAXED_STATE ) ); + short all_view = (relax) ? RELAXED_ALL : MIXED_ALL; + const StringSetArray& all_dss_values + = model.discrete_set_string_values(all_view); + end = dsv_start + num_dsv; + for (i=dsv_start; i= RELAXED_DESIGN && active_view <= RELAXED_STATE ) ); + short all_view = (relax) ? RELAXED_ALL : MIXED_ALL; + const StringSetArray& all_dss_values + = iteratedModel.discrete_set_string_values(all_view); + end = dsv_start + num_dsv; + for (i=dsv_start; i= RELAXED_DESIGN && active_view <= RELAXED_STATE ) ); + short all_view = (relax) ? RELAXED_ALL : MIXED_ALL; + const StringSetArray& all_dss_values + = iteratedModel.discrete_set_string_values(all_view); + + // is care needed to manage active vs. all string variables? + + StringMultiArrayConstView ds_vars = vars.discrete_string_variables(); + for (size_t j=0; j nonrepeatable behavior + randomSeed = generate_system_seed(); + lhsDriver.seed(randomSeed); + } + else if (varyPattern) // define sequence of seed values for numLHSRuns > 1 + lhsDriver.advance_seed_sequence(); + else // fixed_seed + lhsDriver.seed(randomSeed); // reset original/machine-generated seed + + // Needed a way to turn this off when LHS sampling is being used in + // NonDAdaptImpSampling because it gets written a _LOT_ + String sample_string = submethod_enum_to_string(sampleType); + if (write_message) { + Cout << "\nNonD " << sample_string << " Samples = " << numSamples; + if (numLHSRuns == 1 || !varyPattern) { + if (seedSpec) Cout << " Seed (user-specified) = "; + else Cout << " Seed (system-generated) = "; + Cout << randomSeed << '\n'; + } + else if (rngName == "rnum2") { + if (seedSpec) Cout << " Seed (sequence from user-specified) = "; + else Cout << " Seed (sequence from system-generated) = "; + Cout << lhsDriver.seed() << '\n'; + } + else // default Boost Mersenne twister + Cout << " Seed not reset from previous LHS execution\n"; + } + + lhsDriver.initialize(sample_string, sampleRanksMode, !subIteratorFlag); +} + + +void NonDSampling:: +compute_statistics(const RealMatrix& vars_samples, + const IntResponseMap& resp_samples) +{ + StringMultiArrayConstView + acv_labels = iteratedModel.all_continuous_variable_labels(), + adiv_labels = iteratedModel.all_discrete_int_variable_labels(), + adsv_labels = iteratedModel.all_discrete_string_variable_labels(), + adrv_labels = iteratedModel.all_discrete_real_variable_labels(); + size_t cv_start, num_cv, div_start, num_div, dsv_start, num_dsv, + drv_start, num_drv; + mode_counts(iteratedModel, cv_start, num_cv, div_start, num_div, + dsv_start, num_dsv, drv_start, num_drv); + StringMultiArrayConstView + cv_labels = + acv_labels[boost::indices[idx_range(cv_start, cv_start+num_cv)]], + div_labels = + adiv_labels[boost::indices[idx_range(div_start, div_start+num_div)]], + dsv_labels = + adsv_labels[boost::indices[idx_range(dsv_start, dsv_start+num_dsv)]], + drv_labels = + adrv_labels[boost::indices[idx_range(drv_start, drv_start+num_drv)]]; + + // archive the active variables with the results + if (resultsDB.active()) { + if (num_cv) + resultsDB.insert(run_identifier(), resultsNames.cv_labels, cv_labels); + if (num_div) + resultsDB.insert(run_identifier(), resultsNames.div_labels, div_labels); + if (num_dsv) + resultsDB.insert(run_identifier(), resultsNames.dsv_labels, dsv_labels); + if (num_drv) + resultsDB.insert(run_identifier(), resultsNames.drv_labels, drv_labels); + resultsDB.insert(run_identifier(), resultsNames.fn_labels, + iteratedModel.response_labels()); + } + + if (epistemicStats) // Epistemic/mixed + compute_intervals(resp_samples); // compute min/max response intervals + else { // Aleatory + // compute means and std deviations with confidence intervals + compute_moments(resp_samples); + // compute CDF/CCDF mappings of z to p/beta and p/beta to z + if (totalLevelRequests) + compute_distribution_mappings(resp_samples); + } + + // Don't compute for now: too expensive + // if (!subIteratorFlag) { + // nonDSampCorr.compute_correlations(vars_samples, resp_samples); + // // archive the correlations to the results DB + // nonDSampCorr.archive_correlations(run_identifier(), resultsDB, cv_labels, + // div_labels, dsv_labels, drv_labels, + // iteratedModel.response_labels()); + // } + if (!finalStatistics.is_null()) + update_final_statistics(); +} + + +void NonDSampling::compute_intervals(const IntResponseMap& samples) +{ + // For the samples array, calculate min/max response intervals + + using boost::math::isfinite; + size_t i, j, num_obs = samples.size(), num_samp; + const StringArray& resp_labels = iteratedModel.response_labels(); + + if (extremeValues.empty()) extremeValues.shapeUninitialized(2, numFunctions); + IntRespMCIter it; + for (i=0; isecond.function_value(i); + if (isfinite(sample)) { // neither NaN nor +/-Inf + if (sample < min) min = sample; + if (sample > max) max = sample; + ++num_samp; + } + } + extremeValues(0, i) = min; + extremeValues(1, i) = max; + if (num_samp != num_obs) + Cerr << "Warning: sampling statistics for " << resp_labels[i] << " omit " + << num_obs-num_samp << " failed evaluations out of " << num_obs + << " samples.\n"; + } + + if (resultsDB.active()) { + MetaDataType md; + md["Row Labels"] = make_metadatavalue("Min", "Max"); + md["Column Labels"] = make_metadatavalue(resp_labels); + resultsDB.insert(run_identifier(), resultsNames.extreme_values, + extremeValues, md); + } +} + + +void NonDSampling::compute_moments(const IntResponseMap& samples) +{ + // For the samples array, calculate means and standard deviations + // with confidence intervals + + using boost::math::isfinite; + size_t i, j, num_obs = samples.size(), num_samp; + Real sum, var, skew, kurt; + const StringArray& resp_labels = iteratedModel.response_labels(); + + if (momentStats.empty()) momentStats.shapeUninitialized(4, numFunctions); + if (momentCIs.empty()) momentCIs.shapeUninitialized(4, numFunctions); + + IntRespMCIter it; + for (i=0; isecond.function_value(i); + if (isfinite(sample)) { // neither NaN nor +/-Inf + sum += sample; + ++num_samp; + } + } + + if (num_samp != num_obs) + Cerr << "Warning: sampling statistics for " << resp_labels[i] << " omit " + << num_obs-num_samp << " failed evaluations out of " << num_obs + << " samples.\n"; + if (!num_samp) { + Cerr << "Error: Number of samples for " << resp_labels[i] + << " must be nonzero for moment calculation in NonDSampling::" + << "compute_statistics()." << std::endl; + abort_handler(-1); + } + + Real* moments_i = momentStats[i]; + Real& mean = moments_i[0]; + mean = sum/((Real)num_samp); + + // accumulate variance, skewness, and kurtosis + Real centered_fn, pow_fn; + for (it=samples.begin(); it!=samples.end(); ++it) { + const Real& sample = it->second.function_value(i); + if (isfinite(sample)) { // neither NaN nor +/-Inf + pow_fn = centered_fn = sample - mean; + pow_fn *= centered_fn; var += pow_fn; + pow_fn *= centered_fn; skew += pow_fn; + pow_fn *= centered_fn; kurt += pow_fn; + } + } + + // sample std deviation + Real& std_dev = moments_i[1]; + std_dev = (num_samp > 1) ? std::sqrt(var/(Real)(num_samp-1)) : 0.; + + // skewness + moments_i[2] = (num_samp > 2 && var > 0.) ? + // sample skewness + skew/(Real)num_samp/std::pow(var/(Real)num_samp,1.5) * + // population skewness + std::sqrt((Real)(num_samp*(num_samp-1)))/(Real)(num_samp-2) : + // for no variation, central moment is zero + 0.; + + // kurtosis + moments_i[3] = (num_samp > 3 && var > 0.) ? + // sample kurtosis + (Real)((num_samp+1)*num_samp*(num_samp-1))*kurt/ + (Real)((num_samp-2)*(num_samp-3)*var*var) - + // population kurtosis + 3.*std::pow((Real)(num_samp-1),2)/(Real)((num_samp-2)*(num_samp-3)) : + // for no variation, central moment is zero minus excess kurtosis + -3.; + + if (num_samp > 1) { + // 95% confidence intervals (2-sided interval, not 1-sided limit) + Real dof = num_samp - 1; +//#ifdef HAVE_BOOST + // mean: the better formula does not assume known variance but requires + // a function for the Student's t-distr. with (num_samp-1) degrees of + // freedom (Haldar & Mahadevan, p. 127). + Pecos::students_t_dist t_dist(dof); + Real mean_ci_delta = + std_dev*bmth::quantile(t_dist,0.975)/std::sqrt((Real)num_samp); + momentCIs(0,i) = mean - mean_ci_delta; + momentCIs(1,i) = mean + mean_ci_delta; + // std dev: chi-square distribution with (num_samp-1) degrees of freedom + // (Haldar & Mahadevan, p. 132). + Pecos::chi_squared_dist chisq(dof); + momentCIs(2,i) = std_dev*std::sqrt(dof/bmth::quantile(chisq, 0.975)); + momentCIs(3,i) = std_dev*std::sqrt(dof/bmth::quantile(chisq, 0.025)); +/* +#elif HAVE_GSL + // mean: the better formula does not assume known variance but requires + // a function for the Student's t-distr. with (num_samp-1) degrees of + // freedom (Haldar & Mahadevan, p. 127). + mean95CIDeltas[i] + = std_dev*gsl_cdf_tdist_Pinv(0.975,dof)/std::sqrt((Real)num_samp); + // std dev: chi-square distribution with (num_samp-1) degrees of freedom + // (Haldar & Mahadevan, p. 132). + stdDev95CILowerBnds[i] + = std_dev*std::sqrt(dof/gsl_cdf_chisq_Pinv(0.975, dof)); + stdDev95CIUpperBnds[i] + = std_dev*std::sqrt(dof/gsl_cdf_chisq_Pinv(0.025, dof)); +#else + // mean: k_(alpha/2) = Phi^(-1)(0.975) = 1.96 (Haldar & Mahadevan, + // p. 123). This simple formula assumes a known variance, which + // requires a sample of sufficient size (i.e., greater than 10). + mean95CIDeltas[i] = 1.96*std_dev/std::sqrt((Real)num_samp); +#endif // HAVE_BOOST +*/ + } + else + momentCIs(0,i) = momentCIs(1,i) = momentCIs(2,i) = momentCIs(3,i) = 0.0; + } + + if (resultsDB.active()) { + // archive the moments to results DB + MetaDataType md_moments; + md_moments["Row Labels"] = + make_metadatavalue("Mean", "Standard Deviation", "Skewness", "Kurtosis"); + md_moments["Column Labels"] = make_metadatavalue(resp_labels); + resultsDB.insert(run_identifier(), resultsNames.moments_std, + momentStats, md_moments); + // archive the confidence intervals to results DB + MetaDataType md; + md["Row Labels"] = + make_metadatavalue("LowerCI_Mean", "UpperCI_Mean", "LowerCI_StdDev", + "UpperCI_StdDev"); + md["Column Labels"] = make_metadatavalue(resp_labels); + resultsDB.insert(run_identifier(), resultsNames.moment_cis, momentCIs, md); + } +} + + +void NonDSampling::compute_distribution_mappings(const IntResponseMap& samples) +{ + // Size the output arrays here instead of in the ctor in order to support + // alternate sampling ctors. + initialize_distribution_mappings(); + archive_allocate_mappings(); + if (pdfOutput) { + computedPDFAbscissas.resize(numFunctions); + computedPDFOrdinates.resize(numFunctions); + archive_allocate_pdf(); + } + + // For the samples array, calculate the following statistics: + // > CDF/CCDF mappings of response levels to probability/reliability levels + // > CDF/CCDF mappings of probability/reliability levels to response levels + using boost::math::isfinite; + size_t i, j, k, num_obs = samples.size(), num_samp, bin_accumulator; + const StringArray& resp_labels = iteratedModel.response_labels(); + RealArray sorted_samples; // STL-based array for sorting + SizetArray bins; Real min, max; + + // check if moments are required, and if so, compute them now + if (momentStats.empty()) { + bool need_moments = false; + for (i=0; i p/beta/beta* and p/beta/beta* -> z + size_t rl_len = requestedRespLevels[i].length(), + pl_len = requestedProbLevels[i].length(), + bl_len = requestedRelLevels[i].length(), + gl_len = requestedGenRelLevels[i].length(); + + // ---------------------------------------------------------------------- + // Preliminaries: define finite subset, sort (if needed), and bin samples + // ---------------------------------------------------------------------- + num_samp = 0; + if (pl_len || gl_len) { // sort samples array for p/beta* -> z mappings + sorted_samples.clear(); sorted_samples.reserve(num_obs); + for (it=samples.begin(); it!=samples.end(); ++it) { + const Real& sample = it->second.function_value(i); + if (isfinite(sample)) + { ++num_samp; sorted_samples.push_back(sample); } + } + // sort in ascending order + std::sort(sorted_samples.begin(), sorted_samples.end()); + if (pdfOutput) + { min = sorted_samples[0]; max = sorted_samples[num_samp-1]; } + // in case of rl_len mixed with pl_len/gl_len, bin using sorted array. + // Note: all bins open on right end due to use of less than. + if (rl_len && respLevelTarget != RELIABILITIES) { + const RealVector& req_rl_i = requestedRespLevels[i]; + bins.assign(rl_len+1, 0); size_t samp_cntr = 0; + for (j=0; j samp_cntr) + bins[rl_len] += num_samp - samp_cntr; + } + } + else if (rl_len && respLevelTarget != RELIABILITIES) { + // in case of rl_len without pl_len/gl_len, bin from original sample set + const RealVector& req_rl_i = requestedRespLevels[i]; + bins.assign(rl_len+1, 0); min = DBL_MAX; max = -DBL_MAX; + for (it=samples.begin(); it!=samples.end(); ++it) { + const Real& sample = it->second.function_value(i); + if (isfinite(sample)) { + ++num_samp; + if (pdfOutput) { + if (sample < min) min = sample; + if (sample > max) max = sample; + } + // 1st PDF bin from -inf to 1st resp lev; last PDF bin from last resp + // lev to +inf. Note: all bins open on right end due to use of <. + bool found = false; + for (k=0; k p/beta* (based on binning) + bin_accumulator = 0; + for (j=0; j beta (based on moment projection) + Real& mean = momentStats(0,i); Real& std_dev = momentStats(1,i); + for (j=0; j Pecos::SMALL_NUMBER) { + Real ratio = (mean - z)/std_dev; + computedRelLevels[i][j] = (cdfFlag) ? ratio : -ratio; + } + else + computedRelLevels[i][j] + = ( (cdfFlag && mean <= z) || (!cdfFlag && mean > z) ) + ? -Pecos::LARGE_NUMBER : Pecos::LARGE_NUMBER; + } + break; + } + } + } + for (j=0; j z + Real p = (j .9) + ? std::pow(10., ceil(std::log10(cdf_p_x_obs))) : 0.; + int index = (int)std::floor(cdf_p_x_obs - order*DBL_EPSILON); + // clip at array ends due to possible roundoff effects + if (index < 0) index = 0; + if (index >= num_samp) index = num_samp - 1; + if (j z + const Real& beta = requestedRelLevels[i][j]; + computedRespLevels[i][j+pl_len] = (cdfFlag) ? + mean - beta * std_dev : mean + beta * std_dev; + } + } + + // archive the mappings from response levels + archive_from_resp(i); + // archive the mappings to response levels + archive_to_resp(i); + + // --------------------------------------------------------------------- + // Post-process for PDF incorporating all requested/computed resp levels + // --------------------------------------------------------------------- + if (pdfOutput) { + size_t req_comp_rl_len = pl_len + gl_len; + if (respLevelTarget != RELIABILITIES) req_comp_rl_len += rl_len; + if (req_comp_rl_len) { + RealVector pdf_all_rlevs; + if (pl_len || gl_len) { + // merge all requested & computed rlevs into pdf rlevs and sort + pdf_all_rlevs.sizeUninitialized(req_comp_rl_len); + // merge requested/computed --> pdf_all_rlevs + int offset = 0; + if (rl_len && respLevelTarget != RELIABILITIES) { + copy_data_partial(requestedRespLevels[i], pdf_all_rlevs, 0); + offset += rl_len; + } + if (pl_len) { + copy_data_partial(computedRespLevels[i], 0, (int)pl_len, + pdf_all_rlevs, offset); + offset += pl_len; + } + if (gl_len) + copy_data_partial(computedRespLevels[i], (int)(pl_len+bl_len), + (int)gl_len, pdf_all_rlevs, offset); + // sort combined array; retain unique entries; update req_comp_rl_len + Real* start = pdf_all_rlevs.values(); + std::sort(start, start+req_comp_rl_len); + req_comp_rl_len = std::distance(start, + std::unique(start, start+req_comp_rl_len)); + // (re)compute bins from sorted_samples. Note that these bins are + // open on right end due to use of strictly less than. + bins.assign(req_comp_rl_len+1, 0); size_t samp_cntr = 0; + for (j=0; j samp_cntr) + bins[req_comp_rl_len] += num_samp - samp_cntr; + } + RealVector& pdf_rlevs = (pl_len || gl_len) ? + pdf_all_rlevs : requestedRespLevels[i]; + size_t last_rl_index = req_comp_rl_len-1; + const Real& lev_0 = pdf_rlevs[0]; + const Real& lev_last = pdf_rlevs[last_rl_index]; + // to properly sum to 1, final PDF bin must be closed on right end. + // --> where the max sample value defines the last response level, + // move any max samples on right boundary inside last PDF bin. + if (max <= lev_last && bins[req_comp_rl_len]) { + bins[req_comp_rl_len-1] += bins[req_comp_rl_len]; + bins[req_comp_rl_len] = 0; + } + + // compute computedPDF{Abscissas,Ordinates} from bin counts and widths + size_t pdf_size = last_rl_index; + if (min < lev_0) ++pdf_size; + if (max > lev_last) ++pdf_size; + RealVector& abs_i = computedPDFAbscissas[i]; abs_i.resize(pdf_size+1); + RealVector& ord_i = computedPDFOrdinates[i]; ord_i.resize(pdf_size); + size_t offset = 0; + if (min < lev_0) { + abs_i[0] = min; + ord_i[0] = (Real)bins[0]/(Real)num_samp/(lev_0 - min); + offset = 1; + } + for (j=0; j lev_last) { + abs_i[pdf_size-1] = pdf_rlevs[last_rl_index]; + abs_i[pdf_size] = max; + ord_i[pdf_size-1] + = (Real)bins[req_comp_rl_len]/(Real)num_samp/(max - lev_last); + } + else + abs_i[pdf_size] = pdf_rlevs[last_rl_index]; + } + archive_pdf(i); + } + } +} + + +void NonDSampling::update_final_statistics() +{ + //if (finalStatistics.is_null()) + // initialize_final_statistics(); + + if (epistemicStats) { + size_t i, cntr = 0; + for (i=0; i 1) { + // output 95% confidence intervals as (,) interval + s << "\n95% confidence intervals for each response function:\n" + << std::setw(width+15) << "LowerCI_Mean" << std::setw(width+1) + << "UpperCI_Mean" << std::setw(width+1) << "LowerCI_StdDev" + << std::setw(width+2) << "UpperCI_StdDev\n"; + for (i=0; i + (run_identifier(), resultsNames.pdf_histograms, numFunctions, md); +} + + +void NonDSampling::archive_pdf(size_t i) // const +{ + if (!resultsDB.active()) return; + + size_t pdf_len = computedPDFOrdinates[i].length(); + RealMatrix pdf(3, pdf_len); + for (size_t j=0; j + (run_identifier(), resultsNames.pdf_histograms, i, pdf); +} + +} // namespace Dakota + Index: /issm/trunk-jpl/externalpackages/dakota/install-6.2-linux-static.sh =================================================================== --- /issm/trunk-jpl/externalpackages/dakota/install-6.2-linux-static.sh (revision 24648) +++ /issm/trunk-jpl/externalpackages/dakota/install-6.2-linux-static.sh (revision 24649) @@ -10,5 +10,5 @@ ## Environment # -export BLAS_LIBS="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lfblas -L${ISSM_DIR}/lib -lgfortran" # Need to export BLAS_LIBS *and* pass it as an option to CMake to ensure that external packages also find it +export BLAS_LIBS="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lfblas -L/usr/lib/x86_64-linux-gnu -lgfortran" # Need to export BLAS_LIBS *and* pass it as an option to CMake to ensure that external packages also find it export BOOST_ROOT=${ISSM_DIR}/externalpackages/boost/install export CXXFLAGS='-std=c++98' # Setting CXXFLAGS to deal with C++11 incompatibility with Matlab's Boost (absolutely necessary for this version) @@ -17,5 +17,5 @@ export DAK_INSTALL=${DAK_ROOT}/install export DAK_SRC=${DAK_ROOT}/src -export LAPACK_LIBS="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lflapack -L${ISSM_DIR}/lib -lgfortran" # Need to export LAPACK_LIBS *and* pass it as an option to CMake to ensure that external packages also find it +export LAPACK_LIBS="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lflapack -L/usr/lib/x86_64-linux-gnu -lgfortran" # Need to export LAPACK_LIBS *and* pass it as an option to CMake to ensure that external packages also find it # Cleanup @@ -33,12 +33,14 @@ rm -rf dakota-${VER}.0.src -# Copy customized source and configuration files to 'src' driectory +# Copy customized source and configuration files to 'src' directory +cp configs/${VER}/packages/DDACE/src/Analyzer/MainEffectsExcelOutput.cpp ${DAK_SRC}/packages/DDACE/src/Analyzer +cp configs/${VER}/packages/surfpack/src/surfaces/nkm/NKM_KrigingModel.cpp ${DAK_SRC}/packages/surfpack/src/surfaces/nkm +cp configs/${VER}/src/DakotaInterface.cpp ${DAK_SRC}/src +cp configs/${VER}/src/NonDLocalReliability.cpp ${DAK_SRC}/src +cp configs/${VER}/src/NonDSampling.cpp ${DAK_SRC}/src + +# Copy customized source and configuration files specific to Linux to 'src' directory cp configs/${VER}/linux/cmake/BuildDakotaCustom.cmake ${DAK_SRC}/cmake cp configs/${VER}/linux/cmake/DakotaDev.cmake ${DAK_SRC}/cmake -cp configs/${VER}/linux/packages/DDACE/src/Analyzer/MainEffectsExcelOutput.cpp ${DAK_SRC}/packages/DDACE/src/Analyzer -cp configs/${VER}/linux/packages/surfpack/src/surfaces/nkm/NKM_KrigingModel.cpp ${DAK_SRC}/packages/surfpack/src/surfaces/nkm -cp configs/${VER}/linux/src/DakotaInterface.cpp ${DAK_SRC}/src -cp configs/${VER}/linux/src/NonDLocalReliability.cpp ${DAK_SRC}/src -cp configs/${VER}/linux/src/NonDSampling.cpp ${DAK_SRC}/src # Configure Index: /issm/trunk-jpl/externalpackages/dakota/install-6.2-linux.sh =================================================================== --- /issm/trunk-jpl/externalpackages/dakota/install-6.2-linux.sh (revision 24648) +++ /issm/trunk-jpl/externalpackages/dakota/install-6.2-linux.sh (revision 24649) @@ -33,12 +33,14 @@ rm -rf dakota-${VER}.0.src -# Copy customized source and configuration files to 'src' driectory +# Copy customized source and configuration files to 'src' directory +cp configs/${VER}/packages/DDACE/src/Analyzer/MainEffectsExcelOutput.cpp ${DAK_SRC}/packages/DDACE/src/Analyzer +cp configs/${VER}/packages/surfpack/src/surfaces/nkm/NKM_KrigingModel.cpp ${DAK_SRC}/packages/surfpack/src/surfaces/nkm +cp configs/${VER}/src/DakotaInterface.cpp ${DAK_SRC}/src +cp configs/${VER}/src/NonDLocalReliability.cpp ${DAK_SRC}/src +cp configs/${VER}/src/NonDSampling.cpp ${DAK_SRC}/src + +# Copy customized source and configuration files specific to Linux to 'src' directory cp configs/${VER}/linux/cmake/BuildDakotaCustom.cmake ${DAK_SRC}/cmake cp configs/${VER}/linux/cmake/DakotaDev.cmake ${DAK_SRC}/cmake -cp configs/${VER}/linux/packages/DDACE/src/Analyzer/MainEffectsExcelOutput.cpp ${DAK_SRC}/packages/DDACE/src/Analyzer -cp configs/${VER}/linux/packages/surfpack/src/surfaces/nkm/NKM_KrigingModel.cpp ${DAK_SRC}/packages/surfpack/src/surfaces/nkm -cp configs/${VER}/linux/src/DakotaInterface.cpp ${DAK_SRC}/src -cp configs/${VER}/linux/src/NonDLocalReliability.cpp ${DAK_SRC}/src -cp configs/${VER}/linux/src/NonDSampling.cpp ${DAK_SRC}/src # Configure Index: /issm/trunk-jpl/externalpackages/dakota/install-6.2-mac-static.sh =================================================================== --- /issm/trunk-jpl/externalpackages/dakota/install-6.2-mac-static.sh (revision 24649) +++ /issm/trunk-jpl/externalpackages/dakota/install-6.2-mac-static.sh (revision 24649) @@ -0,0 +1,76 @@ +#!/bin/bash +set -eu + + +# Constants +# +DAK_ROOT=${ISSM_DIR}/externalpackages/dakota +VER="6.2" + +## Environment +# +export BLAS_LIBS="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lfblas -L/usr/local/gfortran/lib -lgfortran" # Need to export BLAS_LIBS *and* pass it as an option to CMake to ensure that external packages also find it +export BOOST_ROOT=${ISSM_DIR}/externalpackages/boost/install +export CXXFLAGS='-std=c++98' # Setting CXXFLAGS to deal with C++11 incompatibility with Matlab's Boost (absolutely necessary for this version) +export DAK_BUILD=${DAK_ROOT}/build +export DAK_INSTALL=${DAK_ROOT}/install +export DAK_SRC=${DAK_ROOT}/src +export LAPACK_LIBS="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lflapack -L/usr/local/gfortran/lib -lgfortran" # Need to export LAPACK_LIBS *and* pass it as an option to CMake to ensure that external packages also find it + +# Cleanup +rm -rf build install src +mkdir build install src + +#Download from ISSM server +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/dakota-${VER}-public.src.tar.gz" "dakota-${VER}-public-src.tar.gz" + +# Unpack source +tar -zxvf dakota-${VER}-public-src.tar.gz + +# Move source to 'src' directory +mv dakota-${VER}.0.src/* src +rm -rf dakota-${VER}.0.src + +# Copy customized source and configuration files to 'src' directory +cp configs/${VER}/packages/DDACE/src/Analyzer/MainEffectsExcelOutput.cpp ${DAK_SRC}/packages/DDACE/src/Analyzer +cp configs/${VER}/packages/surfpack/src/surfaces/nkm/NKM_KrigingModel.cpp ${DAK_SRC}/packages/surfpack/src/surfaces/nkm +cp configs/${VER}/src/DakotaInterface.cpp ${DAK_SRC}/src +cp configs/${VER}/src/NonDLocalReliability.cpp ${DAK_SRC}/src +cp configs/${VER}/src/NonDSampling.cpp ${DAK_SRC}/src + +# Copy customized source and configuration files specific to Mac to 'src' directory +cp configs/${VER}/mac/cmake/BuildDakotaCustom.cmake ${DAK_SRC}/cmake +cp configs/${VER}/mac/cmake/DakotaDev.cmake ${DAK_SRC}/cmake +cp configs/${VER}/mac/packages/VPISparseGrid/src/sandia_rules.cpp ${DAK_SRC}/packages/VPISparseGrid/src + +# Configure +cd ${DAK_BUILD} +cmake \ + -DBUILD_SHARED_LIBS=OFF \ + -DBUILD_STATIC_LIBS=ON \ + -DCMAKE_C_COMPILER=${MPI_HOME}/bin/mpicc \ + -DCMAKE_CXX_COMPILER=${MPI_HOME}/bin/mpicxx \ + -DCMAKE_Fortran_COMPILER=${MPI_HOME}/bin/mpif77 \ + -DCMAKE_C_FLAGS="-fPIC" \ + -DCMAKE_CXX_FLAGS="-fPIC -fdelayed-template-parsing" \ + -DCMAKE_Fortran_FLAGS="-fPIC" \ + -DHAVE_ACRO=OFF \ + -DHAVE_JEGA=OFF \ + -C${DAK_SRC}/cmake/BuildDakotaCustom.cmake \ + -C${DAK_SRC}/cmake/DakotaDev.cmake \ + ${DAK_SRC} + +# Compile and install +if [ $# -eq 0 ]; then + make + make install +else + make -j $1 + make -j $1 install +fi + +cd ${DAK_INSTALL} + +# Comment out definition of HAVE_MPI in Teuchos config header file in order to +# avoid conflict with our definition +sed -i -e "s/#define HAVE_MPI/\/* #define HAVE_MPI *\//g" include/Teuchos_config.h Index: /issm/trunk-jpl/externalpackages/dakota/install-6.2-mac.sh =================================================================== --- /issm/trunk-jpl/externalpackages/dakota/install-6.2-mac.sh (revision 24649) +++ /issm/trunk-jpl/externalpackages/dakota/install-6.2-mac.sh (revision 24649) @@ -0,0 +1,74 @@ +#!/bin/bash +set -eu + + +# Constants +# +DAK_ROOT=${ISSM_DIR}/externalpackages/dakota +VER="6.2" + +## Environment +# +export BLAS_LIBS="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lfblas -L/usr/local/gfortran/lib -lgfortran" # Need to export BLAS_LIBS *and* pass it as an option to CMake to ensure that external packages also find it +export BOOST_ROOT=${ISSM_DIR}/externalpackages/boost/install +export CXXFLAGS='-std=c++98' # Setting CXXFLAGS to deal with C++11 incompatibility with Matlab's Boost (absolutely necessary for this version) +export DAK_BUILD=${DAK_ROOT}/build +export DAK_INSTALL=${DAK_ROOT}/install +export DAK_SRC=${DAK_ROOT}/src +export LAPACK_LIBS="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lflapack -L/usr/local/gfortran/lib -lgfortran" # Need to export LAPACK_LIBS *and* pass it as an option to CMake to ensure that external packages also find it + +# Cleanup +rm -rf build install src +mkdir build install src + +# Download source +${ISSM_DIR}/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/dakota-${VER}-public.src.tar.gz" "dakota-${VER}-public-src.tar.gz" + +# Unpack source +tar -zxvf dakota-${VER}-public-src.tar.gz + +# Move source to 'src' directory +mv dakota-${VER}.0.src/* src +rm -rf dakota-${VER}.0.src + +# Copy customized source and configuration files to 'src' directory +cp configs/${VER}/packages/DDACE/src/Analyzer/MainEffectsExcelOutput.cpp ${DAK_SRC}/packages/DDACE/src/Analyzer +cp configs/${VER}/packages/surfpack/src/surfaces/nkm/NKM_KrigingModel.cpp ${DAK_SRC}/packages/surfpack/src/surfaces/nkm +cp configs/${VER}/src/DakotaInterface.cpp ${DAK_SRC}/src +cp configs/${VER}/src/NonDLocalReliability.cpp ${DAK_SRC}/src +cp configs/${VER}/src/NonDSampling.cpp ${DAK_SRC}/src + +# Copy customized source and configuration files specific to Mac to 'src' directory +cp configs/${VER}/mac/cmake/BuildDakotaCustom.cmake ${DAK_SRC}/cmake +cp configs/${VER}/mac/cmake/DakotaDev.cmake ${DAK_SRC}/cmake +cp configs/${VER}/mac/packages/VPISparseGrid/src/sandia_rules.cpp ${DAK_SRC}/packages/VPISparseGrid/src + +# Configure +cd ${DAK_BUILD} +cmake \ + -DBUILD_SHARED_LIBS=ON \ + -DBUILD_STATIC_LIBS=OFF \ + -DCMAKE_C_COMPILER=${MPI_HOME}/bin/mpicc \ + -DCMAKE_CXX_COMPILER=${MPI_HOME}/bin/mpicxx \ + -DCMAKE_Fortran_COMPILER=${MPI_HOME}/bin/mpif77 \ + -DCMAKE_CXX_FLAGS="-fdelayed-template-parsing" \ + -DHAVE_ACRO=OFF \ + -DHAVE_JEGA=OFF \ + -C${DAK_SRC}/cmake/BuildDakotaCustom.cmake \ + -C${DAK_SRC}/cmake/DakotaDev.cmake \ + ${DAK_SRC} + +# Compile and install +if [ $# -eq 0 ]; then + make + make install +else + make -j $1 + make -j $1 install +fi + +cd ${DAK_INSTALL} + +# Comment out definition of HAVE_MPI in Teuchos config header file in order to +# avoid conflict with our definition +sed -i -e "s/#define HAVE_MPI/\/* #define HAVE_MPI *\//g" include/Teuchos_config.h Index: /issm/trunk-jpl/externalpackages/petsc/install-3.12-mac-static.sh =================================================================== --- /issm/trunk-jpl/externalpackages/petsc/install-3.12-mac-static.sh (revision 24649) +++ /issm/trunk-jpl/externalpackages/petsc/install-3.12-mac-static.sh (revision 24649) @@ -0,0 +1,52 @@ +#!/bin/bash +set -eu + + +## Constants +# +VER="3.12.3" + +# Download source +$ISSM_DIR/scripts/DownloadExternalPackage.sh "https://issm.ess.uci.edu/files/externalpackages/petsc-lite-${VER}.tar.gz" "petsc-${VER}.tar.gz" + +# Unpack source +tar -zxvf petsc-${VER}.tar.gz + +# Cleanup +rm -rf install src +mkdir install src + +# Move source to 'src' directory +mv petsc-${VER}/* src/ +rm -rf petsc-${VER} + +# Configure +# +# NOTE: Cannot use --with-fpic option when compiling static libs, +# +# Cannot determine compiler PIC flags if shared libraries is turned off +# Either run using --with-shared-libraries or --with-pic=0 and supply the +# compiler PIC flag via CFLAGS, CXXXFLAGS, and FCFLAGS +# +cd src +./config/configure.py \ + --prefix="${ISSM_DIR}/externalpackages/petsc/install" \ + --PETSC_DIR="${ISSM_DIR}/externalpackages/petsc/src" \ + --with-shared-libraries=0 \ + --CFLAGS="-fPIC" \ + --CXXFLAGS="-fPIC" \ + --FFLAGS="-fPIC" \ + --with-debugging=0 \ + --with-valgrind=0 \ + --with-x=0 \ + --with-ssl=0 \ + --download-fblaslapack=1 \ + --download-mpich=1 \ + --download-metis=1 \ + --download-parmetis=1 \ + --download-scalapack=1 \ + --download-mumps=1 + +# Compile and install +make +make install Index: /issm/trunk-jpl/externalpackages/petsc/install-3.7-mac.sh =================================================================== --- /issm/trunk-jpl/externalpackages/petsc/install-3.7-mac.sh (revision 24648) +++ /issm/trunk-jpl/externalpackages/petsc/install-3.7-mac.sh (revision 24649) @@ -11,5 +11,5 @@ # Unpack source -tar -zxvf petsc-$VER.tar.gz +tar -zxvf petsc-${VER}.tar.gz # Cleanup @@ -18,6 +18,6 @@ # Move source to 'src' directory -mv petsc-$VER/* src/ -rm -rf petsc-$VER +mv petsc-${VER}/* src/ +rm -rf petsc-${VER} # Configure @@ -45,5 +45,2 @@ make -j $1 install fi - -# Return to initial directory -cd .. Index: /issm/trunk-jpl/jenkins/jenkins.sh =================================================================== --- /issm/trunk-jpl/jenkins/jenkins.sh (revision 24648) +++ /issm/trunk-jpl/jenkins/jenkins.sh (revision 24649) @@ -547,5 +547,5 @@ # Check that MATLAB did not exit in error - matlabExitedInError=`grep -E "Activation cannot proceed|license" matlab_log.log | wc -l` + matlabExitedInError=`grep -E "Error|Activation cannot proceed|license" matlab_log.log | wc -l` if [ $matlabExitedInError -ne 0 ] Index: sm/trunk-jpl/jenkins/macosx_pine-island =================================================================== --- /issm/trunk-jpl/jenkins/macosx_pine-island (revision 24648) +++ (revision ) @@ -1,73 +1,0 @@ -#-------------------------------# -# 1: ISSM general configuration # -#-------------------------------# - -# MATLAB path -MATLAB_PATH="/Applications/MATLAB_R2015b.app" - -# ISSM CONFIGURATION -ISSM_CONFIG='\ - --prefix=$ISSM_DIR \ - --disable-static \ - --with-matlab-dir=$MATLAB_PATH \ - --with-mpi-include=$ISSM_DIR/externalpackages/petsc/install/include \ - --with-mpi-libflags="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lmpi -lmpicxx -lmpifort" \ - --with-blas-lapack-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-metis-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-scalapack-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-mumps-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-petsc-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-triangle-dir=$ISSM_DIR/externalpackages/triangle/install \ - --with-chaco-dir=$ISSM_DIR/externalpackages/chaco/install \ - --with-m1qn3-dir=$ISSM_DIR/externalpackages/m1qn3/install \ - --with-semic-dir=$ISSM_DIR/externalpackages/semic/install \ - --with-numthreads=4 \ - --enable-development \ - --enable-debugging \ -' - -# Test suites -MATLAB_TEST=1 -PYTHON_TEST=0 -JAVASCRIPT_TEST=0 -EXAMPLES_TEST=0 - -#-----------------------------------# -# 3: External packages installation # -#-----------------------------------# - -# List of external pakages to be installed and their installation scripts -EXTERNALPACKAGES=" - autotools install.sh - cmake install.sh - petsc install-3.11-mac.sh - triangle install-mac.sh - chaco install.sh - m1qn3 install.sh - semic install.sh - shell2junit install.sh -" - -#-----------------# -# 4: test options # -#-----------------# - -# Number of CPUs used in ISSM compilation -# -# NOTE: One is usually safer as some packages are very sensitive to parallel -# compilation -# -NUMCPUS_INSTALL=4 - -# Number of CPUs used in the nightly runs -NUMCPUS_RUN=2 - -# Nightly run options -# -# See documentation in test/NightlyRun/runme.* for more information -# -# NOTE: -# - test701.m is skipped because it uses full Stokes equations -# -MATLAB_NROPTIONS="'exclude',[701,702,703,435,IdFromString('Dakota')]" -PYTHON_NROPTIONS="--exclude_name 'Dakota'" Index: sm/trunk-jpl/jenkins/macosx_pine-island_dakota_static =================================================================== --- /issm/trunk-jpl/jenkins/macosx_pine-island_dakota_static (revision 24648) +++ (revision ) @@ -1,67 +1,0 @@ -#-------------------------------# -# 1: ISSM general configuration # -#-------------------------------# - -#MATLAB path -MATLAB_PATH="/Applications/MATLAB_R2015b.app" - -#ISSM CONFIGURATION -ISSM_CONFIG='--prefix=$ISSM_DIR \ - --disable-static \ - --enable-standalone-executables \ - --enable-standalone-libraries \ - --with-matlab-dir=$MATLAB_PATH \ - --with-triangle-dir=$ISSM_DIR/externalpackages/triangle/install \ - --with-mpi-include=$ISSM_DIR/externalpackages/mpich/install/include \ - --with-mpi-libflags="-L$ISSM_DIR/externalpackages/mpich/install/lib -lmpi -lpmpi -lmpifort -lmpicxx" \ - --with-petsc-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-scalapack-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-mumps-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-metis-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-m1qn3-dir=$ISSM_DIR/externalpackages/m1qn3/install \ - --with-boost-dir=$ISSM_DIR/externalpackages/boost/install \ - --with-dakota-dir=$ISSM_DIR/externalpackages/dakota/install \ - --with-chaco-dir=$ISSM_DIR/externalpackages/chaco/install \ - --with-fortran-lib="/usr/local/gfortran/lib/libgfortran.a /usr/local/gfortran/lib/libquadmath.a /usr/local/gfortran/lib/gcc/x86_64-apple-darwin14/5.2.0/libgcc.a" \ - --with-numthreads=4' - -#PYTHON and MATLAB testing -MATLAB_TEST=0 -PYTHON_TEST=0 - -#-----------------------------------# -# 3: External packages installation # -#-----------------------------------# - -#List of external pakages to be installed and their installation scripts -EXTERNALPACKAGES=" - autotools install.sh - cmake install.sh - chaco install-macosx64.sh - mpich install-3.2-macosx64-static.sh - m1qn3 install.sh - petsc install-3.7-macosx64-static.sh - triangle install-mac-static.sh - boost install-1.55-macosx-el_capitan.sh - dakota install-6.2-macosx64.sh - shell2junit install.sh -" - -#-----------------# -# 4: test options # -#-----------------# - -#number of cpus used in ISSM installation and compilation (one is usually -#safer as some packages are very sensitive to parallel compilation) -NUMCPUS_INSTALL=4 - -#number of cpus used in the nightly runs. -NUMCPUS_RUN=2 - -#Nightly run options. The matlab routine runme.m will be called -#as follows: runme($MATLAB_NROPTIONS). The options must be understandable -#by Matlab and runme.m -#ex: "'id',[101 102 103]" -## bamg mesh FS -#PYTHON_NROPTIONS="--exclude_name 'Dakota'" -#MATLAB_NROPTIONS="'exclude',[243,701,702,703,435,IdFromString('Dakota')]" Index: sm/trunk-jpl/jenkins/macosx_pine-island_static =================================================================== --- /issm/trunk-jpl/jenkins/macosx_pine-island_static (revision 24648) +++ (revision ) @@ -1,79 +1,0 @@ -#-------------------------------# -# 1: ISSM general configuration # -#-------------------------------# - -# MATLAB path -MATLAB_PATH="/Applications/MATLAB_R2015b.app" - -# ISSM CONFIGURATION -ISSM_CONFIG='\ - --prefix=$ISSM_DIR \ - --disable-static \ - --enable-standalone-executables \ - --enable-standalone-libraries \ - --with-fortran-lib="/usr/local/gfortran/lib/libgfortran.a /usr/local/gfortran/lib/libquadmath.a /usr/local/gfortran/lib/gcc/x86_64-apple-darwin14/5.2.0/libgcc.a" \ - --with-matlab-dir=$MATLAB_PATH \ - --with-mpi-include=$ISSM_DIR/externalpackages/mpich/install/include \ - --with-mpi-libflags="-L$ISSM_DIR/externalpackages/mpich/install/lib -lmpi -lpmpi -lmpifort -lmpicxx" \ - --with-metis-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-scalapack-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-mumps-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-petsc-dir=$ISSM_DIR/externalpackages/petsc/install \ - --with-triangle-dir=$ISSM_DIR/externalpackages/triangle/install \ - --with-chaco-dir=$ISSM_DIR/externalpackages/chaco/install \ - --with-m1qn3-dir=$ISSM_DIR/externalpackages/m1qn3/install \ - --with-semic-dir=$ISSM_DIR/externalpackages/semic/install \ - --with-math77-dir=$ISSM_DIR/externalpackages/math77/install \ -' - -# Test suites -MATLAB_TEST=0 -PYTHON_TEST=0 -JAVASCRIPT_TEST=0 -EXAMPLES_TEST=0 - -#-----------------------------------# -# 3: External packages installation # -#-----------------------------------# - -# List of external pakages to be installed and their installation scripts -# -# NOTE: -# - For SLR capabilities, we need gmsh, math77, and gmt -# - GMT depends on GDAL and NetCDF -# -EXTERNALPACKAGES=" - autotools install.sh - cmake install.sh - mpich install-3.2-mac-static.sh - petsc install-3.7-mac-static.sh - triangle install-mac-static.sh - chaco install.sh - m1qn3 install.sh - semic install.sh - math77 install.sh - gmt install-mac-precompiled.sh - gmsh install-mac-precompiled.sh - shell2junit install.sh -" - -#-----------------# -# 4: test options # -#-----------------# - -# Number of CPUs used in ISSM compilation -# -# NOTE: One is usually safer as some packages are very sensitive to parallel -# compilation -# -NUMCPUS_INSTALL=4 - -# Number of CPUs used in the nightly runs -NUMCPUS_RUN=2 - -# Nightly run options -# -# See documentation in test/NightlyRun/runme.* for more information. -# -PYTHON_NROPTIONS="" -MATLAB_NROPTIONS="" Index: /issm/trunk-jpl/jenkins/pine-island-mac-dakota =================================================================== --- /issm/trunk-jpl/jenkins/pine-island-mac-dakota (revision 24649) +++ /issm/trunk-jpl/jenkins/pine-island-mac-dakota (revision 24649) @@ -0,0 +1,80 @@ +#--------------------# +# ISSM Configuration # +#--------------------# + +# MATLAB path +MATLAB_PATH="/Applications/MATLAB_R2015b.app" + +# ISSM CONFIGURATION +ISSM_CONFIG='\ + --prefix=${ISSM_DIR} \ + --disable-static \ + --enable-development \ + --enable-debugging \ + --with-numthreads=4 \ + --with-matlab-dir=${MATLAB_PATH} \ + --with-python-dir=/System/Library/Frameworks/Python.framework/Versions/2.7 \ + --with-python-numpy-dir=/System/Library/Frameworks/Python.framework/Versions/2.7/Extras/lib/python/numpy \ + --with-fortran-lib="-L/usr/local/gfortran/lib -lgfortran" \ + --with-mpi-include=${ISSM_DIR}/externalpackages/petsc/install/include \ + --with-mpi-libflags="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lmpi -lmpicxx -lmpifort" \ + --with-blas-lapack-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-metis-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-scalapack-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-mumps-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-petsc-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-dakota-dir=${ISSM_DIR}/externalpackages/dakota/install \ + --with-boost-dir=${ISSM_DIR}/externalpackages/boost/install \ + --with-triangle-dir=${ISSM_DIR}/externalpackages/triangle/install \ + --with-chaco-dir=${ISSM_DIR}/externalpackages/chaco/install \ + --with-m1qn3-dir=${ISSM_DIR}/externalpackages/m1qn3/install \ + --with-semic-dir=${ISSM_DIR}/externalpackages/semic/install \ +' + +# Test suites +MATLAB_TEST=1 +PYTHON_TEST=1 +JAVASCRIPT_TEST=0 +EXAMPLES_TEST=0 + +#-----------------------------------# +# 3: External packages installation # +#-----------------------------------# + +#List of external pakages to be installed and their installation scripts +EXTERNALPACKAGES=" + autotools install.sh + cmake install.sh + petsc install-3.12-mac.sh + boost install-1.55-mac.sh + dakota install-6.2-mac.sh + triangle install-mac.sh + chaco install.sh + m1qn3 install.sh + semic install.sh + shell2junit install.sh +" + +#-----------------# +# 4: test options # +#-----------------# + +# Number of CPUs used in ISSM compilation +# +# NOTE: One is usually safer as some packages are very sensitive to parallel +# compilation +# +NUMCPUS_INSTALL=4 + +# Number of CPUs used in the nightly runs +NUMCPUS_RUN=2 + +# Nightly run options +# +# See documentation in test/NightlyRun/runme.* for more information +# +# NOTE: +# - Errors are large for 418, 420 +# +PYTHON_NROPTIONS="--exclude 119 243 514 701 702 703 234 235 418 420 --include_name 'Dakota'" +MATLAB_NROPTIONS="'exclude',[119,243,514,701,702,703,234,235,418,420],'id',[IdFromString('Dakota')]" Index: /issm/trunk-jpl/jenkins/pine_island-mac =================================================================== --- /issm/trunk-jpl/jenkins/pine_island-mac (revision 24649) +++ /issm/trunk-jpl/jenkins/pine_island-mac (revision 24649) @@ -0,0 +1,74 @@ +#--------------------# +# ISSM Configuration # +#--------------------# + +# MATLAB path +MATLAB_PATH="/Applications/MATLAB_R2015b.app" + +# ISSM CONFIGURATION +ISSM_CONFIG='\ + --prefix=${ISSM_DIR} \ + --disable-static \ + --enable-development \ + --enable-debugging \ + --with-numthreads=4 \ + --with-matlab-dir=${MATLAB_PATH} \ + --with-fortran-lib="-L/usr/local/gfortran/lib -lgfortran" \ + --with-mpi-include=${ISSM_DIR}/externalpackages/petsc/install/include \ + --with-mpi-libflags="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lmpi -lmpicxx -lmpifort" \ + --with-blas-lapack-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-metis-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-scalapack-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-mumps-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-petsc-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-triangle-dir=${ISSM_DIR}/externalpackages/triangle/install \ + --with-chaco-dir=${ISSM_DIR}/externalpackages/chaco/install \ + --with-m1qn3-dir=${ISSM_DIR}/externalpackages/m1qn3/install \ + --with-semic-dir=${ISSM_DIR}/externalpackages/semic/install \ +' + +# Test suites +MATLAB_TEST=1 +PYTHON_TEST=0 +JAVASCRIPT_TEST=0 +EXAMPLES_TEST=0 + +#-------------------# +# External Packages # +#-------------------# + +# List of external pakages to be installed and their installation scripts +EXTERNALPACKAGES=" + autotools install.sh + cmake install.sh + petsc install-3.12-mac.sh + triangle install-mac.sh + chaco install.sh + m1qn3 install.sh + semic install.sh + shell2junit install.sh +" + +#---------# +# Testing # +#---------# + +# Number of CPUs used in ISSM compilation +# +# NOTE: One is usually safer as some packages are very sensitive to parallel +# compilation +# +NUMCPUS_INSTALL=4 + +# Number of CPUs used in the nightly runs +NUMCPUS_RUN=2 + +# Nightly run options +# +# See documentation in test/NightlyRun/runme.* for more information +# +# NOTE: +# - test701.m is skipped because it uses full Stokes equations +# +MATLAB_NROPTIONS="'exclude',[701,702,703,435,IdFromString('Dakota')]" +PYTHON_NROPTIONS="--exclude_name 'Dakota'" Index: /issm/trunk-jpl/jenkins/pine_island-mac-binaries =================================================================== --- /issm/trunk-jpl/jenkins/pine_island-mac-binaries (revision 24649) +++ /issm/trunk-jpl/jenkins/pine_island-mac-binaries (revision 24649) @@ -0,0 +1,76 @@ +#--------------------# +# ISSM Configuration # +#--------------------# + +# MATLAB path +MATLAB_PATH="/Applications/MATLAB_R2015b.app" + +# NOTE: +# - We can disable dependency tracking in the Autotools because the binaries +# should always be a one-time build. +# - libgfortran is copied to $ISSM_DIR/lib by packaging script. +# +# ISSM CONFIGURATION +ISSM_CONFIG='\ + --prefix=${ISSM_DIR} \ + --disable-static \ + --enable-standalone-executables \ + --enable-standalone-modules \ + --enable-standalone-libraries \ + --disable-dependency-tracking \ + --with-matlab-dir=${MATLAB_PATH} \ + --with-fortran-lib="-L/usr/local/gfortran/lib -lgfortran" \ + --with-mpi-include=${ISSM_DIR}/externalpackages/petsc/install/include \ + --with-mpi-libflags="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lmpi -lmpicxx -lmpifort" \ + --with-blas-lapack-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-metis-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-scalapack-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-mumps-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-petsc-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-triangle-dir=${ISSM_DIR}/externalpackages/triangle/install \ + --with-chaco-dir=${ISSM_DIR}/externalpackages/chaco/install \ + --with-m1qn3-dir=${ISSM_DIR}/externalpackages/m1qn3/install \ + --with-semic-dir=${ISSM_DIR}/externalpackages/semic/install \ +' + +# Test suites +MATLAB_TEST=0 +PYTHON_TEST=0 +JAVASCRIPT_TEST=0 +EXAMPLES_TEST=0 + +#-------------------# +# External Packages # +#-------------------# + +EXTERNALPACKAGES=" + autotools install.sh + cmake install.sh + petsc install-3.12-mac-static.sh + triangle install-mac-static.sh + chaco install.sh + m1qn3 install.sh + semic install.sh + shell2junit install.sh +" + +#---------# +# Testing # +#---------# + +# Number of CPUs used in ISSM compilation +# +# NOTE: One is usually safer as some packages are very sensitive to parallel +# compilation +# +NUMCPUS_INSTALL=1 + +# Number of CPUs used in the nightly runs +NUMCPUS_RUN=1 + +# Nightly run options +# +# See documentation in test/NightlyRun/runme.* for more information. +# +PYTHON_NROPTIONS="" +MATLAB_NROPTIONS="" Index: /issm/trunk-jpl/jenkins/pine_island-mac-binaries-with_dakota =================================================================== --- /issm/trunk-jpl/jenkins/pine_island-mac-binaries-with_dakota (revision 24649) +++ /issm/trunk-jpl/jenkins/pine_island-mac-binaries-with_dakota (revision 24649) @@ -0,0 +1,82 @@ +#--------------------# +# ISSM Configuration # +#--------------------# + +# MATLAB path +MATLAB_PATH="/Applications/MATLAB_R2015b.app" + +# NOTE: +# - We can disable dependency tracking in the Autotools because the binaries +# should always be a one-time build. +# - libgfortran is copied to $ISSM_DIR/lib by packaging script. +# +# ISSM CONFIGURATION +ISSM_CONFIG='\ + --prefix=${ISSM_DIR} \ + --disable-static \ + --enable-standalone-executables \ + --enable-standalone-modules \ + --enable-standalone-libraries \ + --disable-dependency-tracking \ + --with-matlab-dir=${MATLAB_PATH} \ + --with-python-dir=/System/Library/Frameworks/Python.framework/Versions/2.7 \ + --with-python-numpy-dir=/System/Library/Frameworks/Python.framework/Versions/2.7/Extras/lib/python/numpy \ + --with-fortran-lib="-L/usr/local/gfortran/lib -lgfortran" \ + --with-mpi-include=${ISSM_DIR}/externalpackages/petsc/install/include \ + --with-mpi-libflags="-L${ISSM_DIR}/externalpackages/petsc/install/lib -lmpi -lmpicxx -lmpifort" \ + --with-blas-lapack-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-metis-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-scalapack-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-mumps-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-petsc-dir=${ISSM_DIR}/externalpackages/petsc/install \ + --with-dakota-dir=${ISSM_DIR}/externalpackages/dakota/install \ + --with-boost-dir=${ISSM_DIR}/externalpackages/boost/install \ + --with-triangle-dir=${ISSM_DIR}/externalpackages/triangle/install \ + --with-chaco-dir=${ISSM_DIR}/externalpackages/chaco/install \ + --with-m1qn3-dir=${ISSM_DIR}/externalpackages/m1qn3/install \ + --with-semic-dir=${ISSM_DIR}/externalpackages/semic/install \ +' + +# Test suites +MATLAB_TEST=0 +PYTHON_TEST=0 +JAVASCRIPT_TEST=0 +EXAMPLES_TEST=0 + +#-------------------# +# External Packages # +#-------------------# + +EXTERNALPACKAGES=" + autotools install.sh + cmake install.sh + petsc install-3.12-mac-static.sh + boost install-1.55-mac-static.sh + dakota install-6.2-mac-static.sh + triangle install-mac-static.sh + chaco install.sh + m1qn3 install.sh + semic install.sh + shell2junit install.sh +" + +#---------# +# Testing # +#---------# + +# Number of CPUs used in ISSM compilation +# +# NOTE: One is usually safer as some packages are very sensitive to parallel +# compilation +# +NUMCPUS_INSTALL=1 + +# Number of CPUs used in the nightly runs +NUMCPUS_RUN=1 + +# Nightly run options +# +# See documentation in test/NightlyRun/runme.* for more information. +# +PYTHON_NROPTIONS="" +MATLAB_NROPTIONS="" Index: /issm/trunk-jpl/jenkins/ross-debian_linux-binaries =================================================================== --- /issm/trunk-jpl/jenkins/ross-debian_linux-binaries (revision 24648) +++ /issm/trunk-jpl/jenkins/ross-debian_linux-binaries (revision 24649) @@ -5,6 +5,9 @@ MATLAB_PATH="/usr/local/MATLAB/R2019b" -# NOTE: We can disable dependency tracking in the Autotools because the -# binaries should always be a one-time build. +# NOTE: +# - We can disable dependency tracking in the Autotools because the binaries +# should always be a one-time build. +# - libgfortran will not be available in $ISSM_DIR/lib at compile time: it is +# copied by packaging script. # ISSM_CONFIG='\ Index: /issm/trunk-jpl/jenkins/ross-debian_linux-binaries-with_dakota =================================================================== --- /issm/trunk-jpl/jenkins/ross-debian_linux-binaries-with_dakota (revision 24648) +++ /issm/trunk-jpl/jenkins/ross-debian_linux-binaries-with_dakota (revision 24649) @@ -5,6 +5,9 @@ MATLAB_PATH="/usr/local/MATLAB/R2019b" -# NOTE: We can disable dependency tracking in the Autotools because the -# binaries should always be a one-time build. +# NOTE: +# - We can disable dependency tracking in the Autotools because the binaries +# should always be a one-time build. +# - libgfortran will not be available in $ISSM_DIR/lib at compile time: it is +# copied by packaging script. # ISSM_CONFIG='\ Index: /issm/trunk-jpl/m4/issm_options.m4 =================================================================== --- /issm/trunk-jpl/m4/issm_options.m4 (revision 24648) +++ /issm/trunk-jpl/m4/issm_options.m4 (revision 24649) @@ -190,4 +190,7 @@ [VENDOR=""] dnl action if not given ) + dnl defaults for host OS related variables + IS_MAC=no + IS_WINDOWS=no AC_MSG_CHECKING([for vendor compilers]) if test -n "${VENDOR}"; then @@ -282,4 +285,18 @@ AC_SUBST([OSLIBS]) AC_MSG_RESULT([done]) + + AC_MSG_CHECKING([if this is a Mac build]) + dnl TODO: The following test is a POSIX-compliant way of testing for a + dnl substring, but is not very readable. Perhaps there is a more + dnl readable method of achieving the same? + if test "${host_os#*\"darwin\"}" == "$host_os"; then + IS_MAC=yes + fi + AM_CONDITIONAL([MAC], [test "${IS_MAC}" == "yes"]) + AC_MSG_RESULT([${IS_MAC}]) + + AC_MSG_CHECKING([if this is a Windows build]) + AM_CONDITIONAL([WINDOWS], [test "x${IS_WINDOWS}" == "xyes"]) + AC_MSG_RESULT([${IS_WINDOWS}]) dnl }}} dnl MATLAB{{{ @@ -368,9 +385,4 @@ AC_SUBST([MEXLINK]) fi - dnl }}} - dnl Windows {{{ - AC_MSG_CHECKING([Checking if this is a Windows build... ]) - AM_CONDITIONAL([WINDOWS], [test "x${IS_WINDOWS}" == "xyes"]) - AC_MSG_RESULT([done]) dnl }}} dnl JavaScript{{{ Index: /issm/trunk-jpl/packagers/linux/package-issm-linux-binaries-with_dakota.sh =================================================================== --- /issm/trunk-jpl/packagers/linux/package-issm-linux-binaries-with_dakota.sh (revision 24648) +++ /issm/trunk-jpl/packagers/linux/package-issm-linux-binaries-with_dakota.sh (revision 24649) @@ -6,6 +6,6 @@ LIBGFORTRAN="/usr/lib/x86_64-linux-gnu/libgfortran.so.5.0.0" # Important that this is the library itself LIBGFORTRAN_DIST="${ISSM_DIR}/lib/libgfortran.so.5" # Important the file name matches the SONAME entry in the binaries and other shared libraries which link to it -MATLAB_NROPTIONS="'id',[IdFromString('Dakota')],'exclude',[234,244,250,417,444,445]" -MATLAB_PATH="/usr/local/MATLAB/R2019b" # Exclude any tests with transient solutions that require a restart +MATLAB_NROPTIONS="'id',[IdFromString('Dakota')],'exclude',[234,244,250,417,444,445]" # Exclude any tests with transient solutions that require a restart +MATLAB_PATH="/usr/local/MATLAB/R2019b" PACKAGE="ISSM" # Name of directory to copy distributable files to @@ -47,5 +47,5 @@ # Add/modify required libraries echo "Moving libgfortran to lib/" -cp ${LIBGFORTRAN} ${LIBGFORTRAN_DIST} +cp ${LIBGFORTRAN} ${LIBGFORTRAN_DIST} 2> /dev/null # Run tests @@ -63,5 +63,5 @@ # Check that MATLAB did not exit in error matlabExitCode=`echo $?` -matlabExitedInError=`grep -E "Activation cannot proceed|license|Error" matlab.log | wc -l` +matlabExitedInError=`grep -E "Error|Activation cannot proceed|license" matlab.log | wc -l` if [[ ${matlabExitCode} -ne 0 || ${matlabExitedInError} -ne 0 ]]; then @@ -99,5 +99,5 @@ # Check that Python did not exit in error pythonExitCode=`echo $?` -pythonExitedInError=`grep -E "runme.py: error" python.log | wc -l` +pythonExitedInError=`grep -E "Error|Traceback|bad interpreter" python.log | wc -l` if [[ ${pythonExitCode} -ne 0 || ${pythonExitedInError} -ne 0 ]]; then Index: /issm/trunk-jpl/packagers/linux/package-issm-linux-binaries.sh =================================================================== --- /issm/trunk-jpl/packagers/linux/package-issm-linux-binaries.sh (revision 24648) +++ /issm/trunk-jpl/packagers/linux/package-issm-linux-binaries.sh (revision 24649) @@ -37,5 +37,5 @@ echo "Moving libgfortran to lib/" -cp ${LIBGFORTRAN} ${LIBGFORTRAN_DIST} +cp ${LIBGFORTRAN} ${LIBGFORTRAN_DIST} 2> /dev/null # Run tests @@ -53,5 +53,5 @@ # Check that MATLAB did not exit in error matlabExitCode=`echo $?` -matlabExitedInError=`grep -E "Activation cannot proceed|license|Error" matlab.log | wc -l` +matlabExitedInError=`grep -E "Error|Activation cannot proceed|license" matlab.log | wc -l` if [[ ${matlabExitCode} -ne 0 || ${matlabExitedInError} -ne 0 ]]; then Index: /issm/trunk-jpl/packagers/mac/package-issm-mac-binaries-with_dakota.sh =================================================================== --- /issm/trunk-jpl/packagers/mac/package-issm-mac-binaries-with_dakota.sh (revision 24649) +++ /issm/trunk-jpl/packagers/mac/package-issm-mac-binaries-with_dakota.sh (revision 24649) @@ -0,0 +1,162 @@ +#!/bin/bash + + +## Constants +# +LIBGFORTRAN="/usr/local/gfortran/lib/libgfortran.3.dylib" # Important that this is the library itself +LIBGFORTRAN_DIST="${ISSM_DIR}/lib/libgfortran.3.dylib" # Important the file name matches the SONAME entry in the binaries and other shared libraries which link to it +MATLAB_NROPTIONS="'id',[IdFromString('Dakota')],'exclude',[234,244,250,417,444,445]" # Exclude any tests with transient solutions that require a restart +MATLAB_PATH="/Applications/MATLAB_R2015b.app" +PACKAGE="ISSM" # Name of directory to copy distributable files to + +# Exclude any tests with transient solutions that require a restart +# +# NOTE: +# - All non-excluded tests were running until recent changes to QMU +# - 418 fails with "malloc(): invalid next size (unsorted)"" +# +PYTHON_NROPTIONS="--include_name 'Dakota' --exclude 234 244 250 417 418 444 445" +TARBALL_NAME="issm-mac-with_dakota" +TARBALL="${TARBALL_NAME}.tar.gz" + +# Clean up from previous packaging +echo "Cleaning up existing assets" +cd ${ISSM_DIR} +rm -rf ${PACKAGE} +mkdir ${PACKAGE} + +# Add/modify required binaries +cd ${ISSM_DIR}/bin + +echo "Modifying generic" +cat generic_static.m | sed -e "s/generic_static/generic/g" > generic.m +cat generic_static.py | sed -e "s/generic_static/generic/g" > generic.py + +echo "Moving MPICH binaries to bin/" +if [ -f ${ISSM_DIR}/externalpackages/petsc/install/bin/mpiexec ]; then + cp ${ISSM_DIR}/externalpackages/petsc/install/bin/mpiexec . + cp ${ISSM_DIR}/externalpackages/petsc/install/bin/hydra_pmi_proxy . +elif [ -f ${ISSM_DIR}/externalpackages/mpich/install/bin/mpiexec ]; then + cp ${ISSM_DIR}/externalpackages/mpich/install/bin/mpiexec . + cp ${ISSM_DIR}/externalpackages/mpich/install/bin/hydra_pmi_proxy . +else + echo "MPICH not found" + exit 1 +fi + +# Add/modify required libraries +echo "Moving libgfortran to lib/" +cp ${LIBGFORTRAN} ${LIBGFORTRAN_DIST} 2> /dev/null + +# Run tests +echo "Running tests" +cd ${ISSM_DIR}/test/NightlyRun + +# Check that MATLAB tests run +echo "Running MATLAB tests" + +rm matlab.log 2> /dev/null + +# Run MATLAB tests redirecting output to logfile and suppressing output to console +${MATLAB_PATH}/bin/matlab -nojvm -nosplash -r "try, addpath ${ISSM_DIR}/bin ${ISSM_DIR}/lib; runme(${MATLAB_NROPTIONS}); exit; catch me,fprintf('%s',getReport(me)); exit; end" -logfile matlab.log &> /dev/null + +# Check that MATLAB did not exit in error +matlabExitCode=`echo $?` +matlabExitedInError=`grep -E "Error|Activation cannot proceed|license" matlab.log | wc -l` + +if [[ ${matlabExitCode} -ne 0 || ${matlabExitedInError} -ne 0 ]]; then + echo "----------MATLAB exited in error!----------" + cat matlab.log + echo "-----------End of matlab.log-----------" + + # Clean up execution directory + rm -rf ${ISSM_DIR}/execution/* + + exit 1 +fi + +# Check that all MATLAB tests passed +numMatlabTestsFailed=`cat matlab.log | grep -c -e "FAILED|ERROR"` + +if [[ ${numMatlabTestsFailed} -ne 0 ]]; then + echo "One or more MATLAB tests FAILED" + exit 1; +else + echo "All MATLAB tests PASSED" +fi + +# Check that Python tests run +echo "Running Python tests" + +export PATH="${PATH}:${ISSM_DIR}/bin" +export PYTHONPATH="${ISSM_DIR}/src/m/dev" +export PYTHONSTARTUP="${PYTHONPATH}/devpath.py" +export PYTHONUNBUFFERED=1 # We don't want Python to buffer output, otherwise issm.exe output is not captured + +rm python.log 2> /dev/null +./runme.py ${PYTHON_NROPTIONS} &> python.log 2>&1 + +# Check that Python did not exit in error +pythonExitCode=`echo $?` +pythonExitedInError=`grep -E "Error|Traceback|bad interpreter" python.log | wc -l` + +if [[ ${pythonExitCode} -ne 0 || ${pythonExitedInError} -ne 0 ]]; then + echo "----------Python exited in error!----------" + cat python.log + echo "-----------End of python.log-----------" + + # Clean up execution directory + rm -rf ${ISSM_DIR}/execution/* + + exit 1 +fi + +# Check that all Python tests passed +numPythonTestsFailed=`cat python.log | grep -c -e "FAILED|ERROR"` + +if [[ ${numPythonTestsFailed} -ne 0 ]]; then + echo "One or more Python tests FAILED" + exit 1; +else + echo "All Python tests PASSED" +fi + +# Create tarball +cd ${ISSM_DIR} +rm -f ${TARBALL} +svn cleanup --remove-ignored --remove-unversioned test # Clean up test directory (before copying to package) +echo "Copying assets to package: ${PACKAGE}" +cp -rf bin examples lib scripts test ${PACKAGE}/ +echo "Cleaning up unneeded/unwanted files" +python -m compileall ${PACKAGE}/bin # Precompile all Python scripts to bytecode +rm -f ${PACKAGE}/bin/*.py # Remove all Python scripts +rm -f ${PACKAGE}/bin/generic_static.* # Remove static versions of generic cluster classes +rm -f ${PACKAGE}/lib/*.a # Remove static libraries from package +rm -f ${PACKAGE}/lib/*.la # Remove libtool libraries from package +echo "Creating tarball: ${TARBALL_NAME}" +tar -czf ${TARBALL} ${PACKAGE} +ls -lah ${ISSM_DIR}/${TARBALL} + +echo "Shipping binaries to website" + +# We're using public key authentication method to upload the tarball The +# following lines check to see if the SSH Agent is running. If not, then it is +# started and relevant information is forwarded to a script. +pgrep "ssh-agent" > /dev/null +if [ $? -ne 0 ]; then + echo "SSH Agent is not running. Starting it..." + ssh-agent > ~/.ssh/agent.sh +else + echo "SSH Agent is running..." +fi + +source ~/.ssh/agent.sh +ssh-add ~/.ssh/debian_linux-vm-to-ross + +scp ${TARBALL} ross.ics.uci.edu:/var/www/html/${TARBALL} + +if [ $? -ne 0 ]; then + echo "The upload failed." + echo "Perhaps the SSH Agent was started by some other means." + echo "Try killing the agent and running again." +fi Index: /issm/trunk-jpl/packagers/mac/package-issm-mac-binaries.sh =================================================================== --- /issm/trunk-jpl/packagers/mac/package-issm-mac-binaries.sh (revision 24649) +++ /issm/trunk-jpl/packagers/mac/package-issm-mac-binaries.sh (revision 24649) @@ -0,0 +1,114 @@ +#!/bin/bash + + +## Constants +# +LIBGFORTRAN="/usr/local/gfortran/lib/libgfortran.3.dylib" # Important that this is the library itself +LIBGFORTRAN_DIST="${ISSM_DIR}/lib/libgfortran.3.dylib" # Important the file name matches the SONAME entry in the binaries and other shared libraries which link to it +MATLAB_NROPTIONS="'exclude',[IdFromString('Dakota'),125,126]" # Exclude Dakota tests and any tests with transient solutions that require a restart +MATLAB_PATH="/Applications/MATLAB_R2015b.app" +PACKAGE="ISSM" # Name of directory to copy distributable files to +TARBALL_NAME="issm-mac" +TARBALL="${TARBALL_NAME}.tar.gz" + +# Clean up from previous packaging +echo "Cleaning up existing assets" +cd ${ISSM_DIR} +rm -rf ${PACKAGE} +mkdir ${PACKAGE} + +# Add/modify required binaries and libraries +cd ${ISSM_DIR}/bin + +echo "Modify generic" +cat generic_static.m | sed -e "s/generic_static/generic/g" > generic.m + +echo "Moving MPICH binaries to bin/" +if [ -f ${ISSM_DIR}/externalpackages/petsc/install/bin/mpiexec ]; then + cp ${ISSM_DIR}/externalpackages/petsc/install/bin/mpiexec . + cp ${ISSM_DIR}/externalpackages/petsc/install/bin/hydra_pmi_proxy . +elif [ -f ${ISSM_DIR}/externalpackages/mpich/install/bin/mpiexec ]; then + cp ${ISSM_DIR}/externalpackages/mpich/install/bin/mpiexec . + cp ${ISSM_DIR}/externalpackages/mpich/install/bin/hydra_pmi_proxy . +else + echo "MPICH not found" + exit 1 +fi + +echo "Moving libgfortran to lib/" +cp ${LIBGFORTRAN} ${LIBGFORTRAN_DIST} 2> /dev/null + +# Run tests +echo "Running tests" +cd ${ISSM_DIR}/test/NightlyRun + +# Check that MATLAB tests run +echo "Running MATLAB tests" + +rm matlab.log 2> /dev/null + +# Run MATLAB tests redirecting output to logfile and suppressing output to console +${MATLAB_PATH}/bin/matlab -nojvm -nosplash -r "try, addpath ${ISSM_DIR}/bin ${ISSM_DIR}/lib; runme(${MATLAB_NROPTIONS}); exit; catch me,fprintf('%s',getReport(me)); exit; end" -logfile matlab.log 2> /dev/null + +# Check that MATLAB did not exit in error +matlabExitCode=`echo $?` +matlabExitedInError=`grep -E "Error|Activation cannot proceed|license" matlab.log | wc -l` + +if [[ ${matlabExitCode} -ne 0 || ${matlabExitedInError} -ne 0 ]]; then + echo "----------MATLAB exited in error!----------" + cat matlab.log + echo "-----------End of matlab.log-----------" + + # Clean up execution directory + rm -rf ${ISSM_DIR}/execution/* + + exit 1 +fi + +# Check that all MATLAB tests passed +numMatlabTestsFailed=`cat matlab.log | grep -c -e "FAILED|ERROR"` + +if [[ ${numMatlabTestsFailed} -ne 0 ]]; then + echo "One or more MATLAB tests FAILED" + exit 1; +else + echo "All MATLAB tests PASSED" +fi + +# Create tarball +cd ${ISSM_DIR} +rm -f ${TARBALL} +svn cleanup --remove-ignored --remove-unversioned test # Clean up test directory (before copying to package) +echo "Copying assets to package: ${PACKAGE}" +cp -rf bin examples lib scripts test ${PACKAGE}/ +echo "Cleaning up unneeded/unwanted files" +rm -f ${PACKAGE}/bin/generic_static.* # Remove static versions of generic cluster classes +rm -f ${PACKAGE}/lib/*.a # Remove static libraries from package (we only need MEX-files) +rm -f ${PACKAGE}/lib/*.la # Remove libtool libraries from package +echo "Creating tarball: ${TARBALL_NAME}" +tar -czf ${TARBALL} ${PACKAGE} +ls -lah ${ISSM_DIR}/${TARBALL} + +echo "Shipping binaries to website" + +# We're using public key authentication method to upload the tarball The +# following lines check to see if the SSH Agent is running. If not, then it is +# started and relevant information is forwarded to a script. +pgrep "ssh-agent" > /dev/null +if [ $? -ne 0 ]; then + echo "SSH Agent is not running. Starting it..." + ssh-agent > ~/.ssh/agent.sh +else + echo "SSH Agent is running..." +fi + +source ~/.ssh/agent.sh +ssh-add ~/.ssh/debian_linux-vm-to-ross + +scp ${TARBALL} ross.ics.uci.edu:/var/www/html/${TARBALL} + +if [ $? -ne 0 ]; then + echo "The upload failed." + echo "Perhaps the SSH Agent was started by some other means." + echo "Try killing the agent and running again." +fi