ifeq ($(BUILD_LAPACK_DEPRECATED), 1)
-@echo "BUILD_DEPRECATED = 1" >> $(NETLIB_LAPACK_DIR)/make.inc
endif
+ -@echo "LAPACKE_WITH_TMG = 1" >> $(NETLIB_LAPACK_DIR)/make.inc
-@cat make.inc >> $(NETLIB_LAPACK_DIR)/make.inc
endif
ilaenv, ieeeck, lsamen, iparmq,
ilaprec, ilatrans, ilauplo, iladiag,
ilaver, slamch, slamc3,
-
+
# SCLAUX -- Auxiliary routines called from both REAL and COMPLEX.
# excluded: second_$(TIMER)
sbdsdc,
sladiv1,
dladiv1,
iparam2stage,
+
+ # functions added for lapack-3.8.0
+
+ ilaenv2stage,
+ ssysv_aa_2stage,
+ ssytrf_aa_2stage,
+ ssytrs_aa_2stage,
+ chesv_aa_2stage,
+ chetrf_aa_2stage,
+ chetrs_aa_2stage,
+ csysv_aa_2stage,
+ csytrf_aa_2stage,
+ csytrs_aa_2stage,
+ dsysv_aa_2stage,
+ dsytrf_aa_2stage,
+ dsytrs_aa_2stage,
+ zhesv_aa_2stage,
+ zhetrf_aa_2stage,
+ zhetrs_aa_2stage,
+ zsysv_aa_2stage,
+ zsytrf_aa_2stage,
+ zsytrs_aa_2stage
);
@lapack_extendedprecision_objs = (
LAPACKE_zuncsd2by1_work,
## new function from lapack-3.7.0
-
+ LAPACKE_cgelq,
+ LAPACKE_cgelq_work,
+ LAPACKE_cgemlq,
+ LAPACKE_cgemlq_work,
LAPACKE_cgemqr,
LAPACKE_cgemqr_work,
+ LAPACKE_cgeqr,
+ LAPACKE_cgeqr_work,
LAPACKE_cgetsls,
LAPACKE_cgetsls_work,
LAPACKE_chbev_2stage,
LAPACKE_csytrs_aa_work,
LAPACKE_csytrs_3,
LAPACKE_csytrs_3_work,
+ LAPACKE_dgelq,
+ LAPACKE_dgelq_work,
+ LAPACKE_dgemlq,
+ LAPACKE_dgemlq_work,
LAPACKE_dgemqr,
LAPACKE_dgemqr_work,
+ LAPACKE_dgeqr,
+ LAPACKE_dgeqr_work,
LAPACKE_dgetsls,
LAPACKE_dgetsls_work,
LAPACKE_dsbev_2stage,
LAPACKE_dsytrs_aa_work,
LAPACKE_dsytrs_3,
LAPACKE_dsytrs_3_work,
+ LAPACKE_sgelq,
+ LAPACKE_sgelq_work,
+ LAPACKE_sgemlq,
+ LAPACKE_sgemlq_work,
LAPACKE_sgemqr,
LAPACKE_sgemqr_work,
+ LAPACKE_sgeqr,
+ LAPACKE_sgeqr_work,
LAPACKE_sgetsls,
LAPACKE_sgetsls_work,
LAPACKE_ssbev_2stage,
LAPACKE_ssytrs_aa_work,
LAPACKE_ssytrs_3,
LAPACKE_ssytrs_3_work,
+ LAPACKE_zgelq,
+ LAPACKE_zgelq_work,
+ LAPACKE_zgemlq,
+ LAPACKE_zgemlq_work,
LAPACKE_zgemqr,
LAPACKE_zgemqr_work,
+ LAPACKE_zgeqr,
+ LAPACKE_zgeqr_work,
LAPACKE_zgetsls,
LAPACKE_zgetsls_work,
LAPACKE_zhbev_2stage,
LAPACKE_zsytrs_aa_work,
LAPACKE_zsytrs_3,
LAPACKE_zsytrs_3_work,
+
+ ## new function from lapack-3.8.0
+ LAPACKE_chesv_aa_2stage,
+ LAPACKE_chesv_aa_2stage_work,
+ LAPACKE_chetrf_aa_2stage,
+ LAPACKE_chetrf_aa_2stage_work,
+ LAPACKE_chetrs_aa_2stage,
+ LAPACKE_chetrs_aa_2stage_work,
+ LAPACKE_clacrm,
+ LAPACKE_clacrm_work,
+ LAPACKE_clarcm,
+ LAPACKE_clarcm_work,
+ LAPACKE_classq,
+ LAPACKE_classq_work,
+ LAPACKE_csysv_aa_2stage,
+ LAPACKE_csysv_aa_2stage_work,
+ LAPACKE_csytrf_aa_2stage,
+ LAPACKE_csytrf_aa_2stage_work,
+ LAPACKE_csytrs_aa_2stage,
+ LAPACKE_csytrs_aa_2stage_work,
+ LAPACKE_dlassq,
+ LAPACKE_dlassq_work,
+ LAPACKE_dsysv_aa_2stage,
+ LAPACKE_dsysv_aa_2stage_work,
+ LAPACKE_dsytrf_aa_2stage,
+ LAPACKE_dsytrf_aa_2stage_work,
+ LAPACKE_dsytrs_aa_2stage,
+ LAPACKE_dsytrs_aa_2stage_work,
+ LAPACKE_get_nancheck,
+ LAPACKE_set_nancheck,
+ LAPACKE_slassq,
+ LAPACKE_slassq_work,
+ LAPACKE_ssysv_aa_2stage,
+ LAPACKE_ssysv_aa_2stage_work,
+ LAPACKE_ssytrf_aa_2stage,
+ LAPACKE_ssytrf_aa_2stage_work,
+ LAPACKE_ssytrs_aa_2stage,
+ LAPACKE_ssytrs_aa_2stage_work,
+ LAPACKE_zhbev_2stage,
+ LAPACKE_zhbev_2stage_work,
+ LAPACKE_zhbevd_2stage,
+ LAPACKE_zhbevd_2stage_work,
+ LAPACKE_zhbevx_2stage,
+ LAPACKE_zhbevx_2stage_work,
+ LAPACKE_zhesv_aa_2stage,
+ LAPACKE_zhesv_aa_2stage_work,
+ LAPACKE_zhetrf_aa_2stage,
+ LAPACKE_zhetrf_aa_2stage_work,
+ LAPACKE_zhetrs_aa_2stage,
+ LAPACKE_zhetrs_aa_2stage_work,
+ LAPACKE_zlacrm,
+ LAPACKE_zlacrm_work,
+ LAPACKE_zlarcm,
+ LAPACKE_zlarcm_work,
+ LAPACKE_zlassq,
+ LAPACKE_zlassq_work,
+ LAPACKE_zsysv_aa_2stage,
+ LAPACKE_zsysv_aa_2stage_work,
+ LAPACKE_zsytrf_aa_2stage,
+ LAPACKE_zsytrf_aa_2stage_work,
+ LAPACKE_zsytrs_aa_2stage,
+ LAPACKE_zsytrs_aa_2stage_work,
);
#These function may need 2 underscores.
--- /dev/null
+# ignore objects and archives, anywhere in the tree.
+*.[oa]
+
+# test in INSTALL
+INSTALL/test*
+
+# local make.inc
+make.inc
+
+# BLAS testing
+BLAS/TESTING/*.out
+BLAS/TESTING/x*
+
+# CBLAS
+CBLAS/include/cblas_mangling.h
+
+# CBLAS testing
+CBLAS/testing/*.out
+CBLAS/testing/x*
+
+# CBLAS examples
+CBLAS/examples/cblas_ex1
+CBLAS/examples/cblas_ex2
+
+# LAPACK testing
+TESTING/LIN/xlintst*
+TESTING/EIG/xeigtst*
+TESTING/*.out
+TESTING/*.txt
+TESTING/x*
+
+# LAPACKE example
+LAPACKE/example/xexample*
+
+# SED
+SRC/*-e
+LAPACKE/src/*-e
--- /dev/null
+language: cpp
+
+addons:
+ apt:
+ sources:
+ - george-edison55-precise-backports # cmake
+ packages:
+ - cmake
+ - cmake-data
+ - gfortran
+
+os:
+ - linux
+ - osx
+
+env:
+ - CMAKE_BUILD_TYPE=Release
+ - CMAKE_BUILD_TYPE=Coverage
+
+install:
+ - if [[ "$TRAVIS_OS_NAME" == "osx" ]];
+ then
+ for pkg in gcc cmake; do
+ if brew list -1 | grep -q "^${pkg}\$"; then
+ brew outdated $pkg || brew upgrade $pkg;
+ else
+ brew install $pkg;
+ fi
+ done
+ fi
+
+script:
+ - export PR=https://api.github.com/repos/$TRAVIS_REPO_SLUG/pulls/$TRAVIS_PULL_REQUEST
+ - export BRANCH=$(if [ "$TRAVIS_PULL_REQUEST" == "false" ]; then echo $TRAVIS_BRANCH; else echo `curl -s $PR | jq -r .head.ref`; fi)
+ - echo "TRAVIS_BRANCH=$TRAVIS_BRANCH, PR=$PR, BRANCH=$BRANCH"
+ - export SRC_DIR=$(pwd)
+ - export BLD_DIR=${SRC_DIR}/lapack-travis-bld
+ - export INST_DIR=${SRC_DIR}/../lapack-travis-install
+ - mkdir -p ${BLD_DIR}
+ - cd ${BLD_DIR}
+# See issue #17 on github dashboard. Once resolved, use -DCBLAS=ON
+# - cmake -DCMAKE_INSTALL_PREFIX=${INST_DIR} -DLAPACKE=ON ${SRC_DIR}
+ - cmake -DBUILDNAME:STRING="travis-${TRAVIS_OS_NAME}-${BRANCH}"
+ -DCMAKE_BUILD_TYPE=${CMAKE_BUILD_TYPE}
+ -DCMAKE_INSTALL_PREFIX=${INST_DIR}
+ -DCBLAS:BOOL=ON
+ -DLAPACKE:BOOL=ON
+ -DBUILD_TESTING=ON
+ -DLAPACKE_WITH_TMG:BOOL=ON
+ ${SRC_DIR}
+ - ctest -D ExperimentalStart
+ - ctest -D ExperimentalConfigure
+ - ctest -D ExperimentalBuild -j2
+ - ctest -D ExperimentalTest --schedule-random -j2 --output-on-failure --timeout 100
+ - ctest -D ExperimentalSubmit
+ - make install -j2
+ - if [[ "$CMAKE_BUILD_TYPE" == "Coverage" ]];
+ then
+ echo "Coverage";
+ make coverage;
+ bash <(curl -s https://codecov.io/bash) -X gcov;
+ fi
add_subdirectory(SRC)
if(BUILD_TESTING)
-add_subdirectory(TESTING)
+ add_subdirectory(TESTING)
endif()
configure_file(${CMAKE_CURRENT_SOURCE_DIR}/blas.pc.in ${CMAKE_CURRENT_BINARY_DIR}/blas.pc @ONLY)
install(FILES
--- /dev/null
+include ../make.inc
+
+all: blas
+
+blas:
+ $(MAKE) -C SRC
+
+blas_testing: blas
+ $(MAKE) -C TESTING run
+
+clean:
+ $(MAKE) -C SRC clean
+ $(MAKE) -C TESTING clean
+cleanobj:
+ $(MAKE) -C SRC cleanobj
+ $(MAKE) -C TESTING cleanobj
+cleanlib:
+ $(MAKE) -C SRC cleanlib
+cleanexe:
+ $(MAKE) -C TESTING cleanexe
+cleantest:
+ $(MAKE) -C TESTING cleantest
# DBLAS3 -- Double precision real BLAS3 routines
# ZBLAS3 -- Double precision complex BLAS3 routines
#
-# The library can be set up to include routines for any combination
-# of the four precisions. To create or add to the library, enter make
-# followed by one or more of the precisions desired. Some examples:
-# make single
-# make single complex
-# make single double complex complex16
-# Note that these commands are not safe for parallel builds.
-#
-# Alternatively, the commands
-# make all
-# or
-# make
-# without any arguments creates a library of all four precisions.
-# The name of the library is held in BLASLIB, which is set in the
-# top-level make.inc
-#
-# To remove the object files after the library is created, enter
-# make clean
-# To force the source files to be recompiled, enter, for example,
-# make single FRC=FRC
-#
-#---------------------------------------------------------------------
-#
-# Edward Anderson, University of Tennessee
-# March 26, 1990
-# Susan Ostrouchov, Last updated September 30, 1994
-# ejr, May 2006.
-#
#######################################################################
#---------------------------------------------------------
-# Comment out the next 6 definitions if you already have
-# the Level 1 BLAS.
+# Level 1 BLAS
#---------------------------------------------------------
set(SBLAS1 isamax.f sasum.f saxpy.f scopy.f sdot.f snrm2.f
srot.f srotg.f sscal.f sswap.f sdsdot.f srotmg.f srotm.f)
set(ZB1AUX idamax.f dasum.f daxpy.f dcopy.f dnrm2.f dscal.f)
#---------------------------------------------------------------------
-# The following line defines auxiliary routines needed by both the
-# Level 2 and Level 3 BLAS. Comment it out only if you already have
-# both the Level 2 and 3 BLAS.
+# Auxiliary routines needed by both the Level 2 and Level 3 BLAS
#---------------------------------------------------------------------
set(ALLBLAS lsame.f xerbla.f xerbla_array.f)
#---------------------------------------------------------
-# Comment out the next 4 definitions if you already have
-# the Level 2 BLAS.
+# Level 2 BLAS
#---------------------------------------------------------
set(SBLAS2 sgemv.f sgbmv.f ssymv.f ssbmv.f sspmv.f
strmv.f stbmv.f stpmv.f strsv.f stbsv.f stpsv.f
zgerc.f zgeru.f zher.f zhpr.f zher2.f zhpr2.f)
#---------------------------------------------------------
-# Comment out the next 4 definitions if you already have
-# the Level 3 BLAS.
+# Level 3 BLAS
#---------------------------------------------------------
set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f)
set(ZBLAS3 zgemm.f zsymm.f zsyrk.f zsyr2k.f ztrmm.f ztrsm.f
zhemm.f zherk.f zher2k.f)
-# default build all of it
-set(ALLOBJ ${SBLAS1} ${SBLAS2} ${SBLAS3} ${DBLAS1} ${DBLAS2} ${DBLAS3}
- ${CBLAS1} ${CBLAS2} ${CBLAS3} ${ZBLAS1}
- ${ZBLAS2} ${ZBLAS3} ${ALLBLAS})
-
-if(BLAS_SINGLE)
- set(ALLOBJ ${SBLAS1} ${ALLBLAS}
- ${SBLAS2} ${SBLAS3})
+
+
+set(SOURCES)
+if(BUILD_SINGLE)
+ list(APPEND SOURCES ${SBLAS1} ${ALLBLAS} ${SBLAS2} ${SBLAS3})
endif()
-if(BLAS_DOUBLE)
- set(ALLOBJ ${DBLAS1} ${ALLBLAS}
- ${DBLAS2} ${DBLAS3})
+if(BUILD_DOUBLE)
+ list(APPEND SOURCES ${DBLAS1} ${ALLBLAS} ${DBLAS2} ${DBLAS3})
endif()
-if(BLAS_COMPLEX)
- set(ALLOBJ ${BLASLIB} ${CBLAS1} ${CB1AUX}
- ${ALLBLAS} ${CBLAS2})
+if(BUILD_COMPLEX)
+ list(APPEND SOURCES ${CBLAS1} ${CB1AUX} ${ALLBLAS} ${CBLAS2} ${CBLAS3})
endif()
-if(BLAS_COMPLEX16)
- set(ALLOBJ ${BLASLIB} ${ZBLAS1} ${ZB1AUX}
- ${ALLBLAS} ${ZBLAS2} ${ZBLAS3})
+if(BUILD_COMPLEX16)
+ list(APPEND SOURCES ${ZBLAS1} ${ZB1AUX} ${ALLBLAS} ${ZBLAS2} ${ZBLAS3})
endif()
+list(REMOVE_DUPLICATES SOURCES)
-
-add_library(blas ${ALLOBJ})
-#if(UNIX)
-# target_link_libraries(blas m)
-#endif()
+add_library(blas ${SOURCES})
set_target_properties(
blas PROPERTIES
VERSION ${LAPACK_VERSION}
SOVERSION ${LAPACK_MAJOR_VERSION}
)
-target_link_libraries(blas)
lapack_install_library(blas)
# top-level make.inc
#
# To remove the object files after the library is created, enter
-# make clean
+# make cleanobj
# To force the source files to be recompiled, enter, for example,
# make single FRC=FRC
#
$(ZBLAS2) $(ZBLAS3) $(ALLBLAS)
$(BLASLIB): $(ALLOBJ)
- $(ARCH) $(ARCHFLAGS) $@ $(ALLOBJ)
+ $(ARCH) $(ARCHFLAGS) $@ $^
$(RANLIB) $@
single: $(SBLAS1) $(ALLBLAS) $(SBLAS2) $(SBLAS3)
- $(ARCH) $(ARCHFLAGS) $(BLASLIB) $(SBLAS1) $(ALLBLAS) \
- $(SBLAS2) $(SBLAS3)
+ $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^
$(RANLIB) $(BLASLIB)
double: $(DBLAS1) $(ALLBLAS) $(DBLAS2) $(DBLAS3)
- $(ARCH) $(ARCHFLAGS) $(BLASLIB) $(DBLAS1) $(ALLBLAS) \
- $(DBLAS2) $(DBLAS3)
+ $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^
$(RANLIB) $(BLASLIB)
complex: $(CBLAS1) $(CB1AUX) $(ALLBLAS) $(CBLAS2) $(CBLAS3)
- $(ARCH) $(ARCHFLAGS) $(BLASLIB) $(CBLAS1) $(CB1AUX) \
- $(ALLBLAS) $(CBLAS2) $(CBLAS3)
+ $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^
$(RANLIB) $(BLASLIB)
complex16: $(ZBLAS1) $(ZB1AUX) $(ALLBLAS) $(ZBLAS2) $(ZBLAS3)
- $(ARCH) $(ARCHFLAGS) $(BLASLIB) $(ZBLAS1) $(ZB1AUX) \
- $(ALLBLAS) $(ZBLAS2) $(ZBLAS3)
+ $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^
$(RANLIB) $(BLASLIB)
FRC:
@FRC=$(FRC)
-clean:
+clean: cleanobj cleanlib
+cleanobj:
rm -f *.o
+cleanlib:
+ #rm -f $(BLASLIB) # May point to a system lib, e.g. -lblas
.f.o:
$(FORTRAN) $(OPTS) -c -o $@ $<
*> CAXPY constant times a vector plus a vector.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] CA
+*> \verbatim
+*> CA is COMPLEX
+*> On entry, CA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] CX
+*> \verbatim
+*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of CX
+*> \endverbatim
+*>
+*> \param[in,out] CY
+*> \verbatim
+*> CY is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of CY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_blas_level1
*
* =====================================================================
SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
COMPLEX CA
*> CCOPY copies a vector x to a vector y.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] CX
+*> \verbatim
+*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of CX
+*> \endverbatim
+*>
+*> \param[out] CY
+*> \verbatim
+*> CY is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of CY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_blas_level1
*
* =====================================================================
SUBROUTINE CCOPY(N,CX,INCX,CY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] CX
+*> \verbatim
+*> CX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of CX
+*> \endverbatim
+*>
+*> \param[in] CY
+*> \verbatim
+*> CY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of CY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_blas_level1
*
* =====================================================================
COMPLEX FUNCTION CDOTC(N,CX,INCX,CY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] CX
+*> \verbatim
+*> CX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of CX
+*> \endverbatim
+*>
+*> \param[in] CY
+*> \verbatim
+*> CY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of CY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_blas_level1
*
* =====================================================================
COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry, the leading ( kl + ku + 1 ) by n part of the
*> array A must contain the matrix of coefficients, supplied
*> column by column, with the leading diagonal of the matrix in
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of DIMENSION at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX array of DIMENSION at least
+*> Y is COMPLEX array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX array, dimension ( LDA, ka ), where ka is
*> k when TRANSA = 'N' or 'n', and is m otherwise.
*> Before entry with TRANSA = 'N' or 'n', the leading m by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX array of DIMENSION ( LDB, kb ), where kb is
+*> B is COMPLEX array, dimension ( LDB, kb ), where kb is
*> n when TRANSB = 'N' or 'n', and is k otherwise.
*> Before entry with TRANSB = 'N' or 'n', the leading k by n
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX array of DIMENSION ( LDC, n ).
+*> C is COMPLEX array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> \endverbatim
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of DIMENSION at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX array of DIMENSION at least
+*> Y is COMPLEX array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the m
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is COMPLEX array of dimension at least
+*> Y is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients. On exit, A is
*> overwritten by the updated matrix.
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the m
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is COMPLEX array of dimension at least
+*> Y is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients. On exit, A is
*> overwritten by the updated matrix.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the hermitian matrix, supplied column by
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of DIMENSION at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the
*> vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX array of DIMENSION at least
+*> Y is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the
*> vector y. On exit, Y is overwritten by the updated vector y.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX array, dimension ( LDA, ka ), where ka is
*> m when SIDE = 'L' or 'l' and is n otherwise.
*> Before entry with SIDE = 'L' or 'l', the m by m part of
*> the array A must contain the hermitian matrix, such that
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX array of DIMENSION ( LDB, n ).
+*> B is COMPLEX array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B.
*> \endverbatim
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX array of DIMENSION ( LDC, n ).
+*> C is COMPLEX array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX array of dimension at least
+*> Y is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y. On exit, Y is overwritten by the updated
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is COMPLEX array of dimension at least
+*> Y is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX array of DIMENSION ( LDB, kb ), where kb is
+*> B is COMPLEX array, dimension ( LDB, kb ), where kb is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX array of DIMENSION ( LDC, n ).
+*> C is COMPLEX array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX array of DIMENSION ( LDC, n ).
+*> C is COMPLEX array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] AP
*> \verbatim
-*> AP is COMPLEX array of DIMENSION at least
+*> AP is COMPLEX array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the hermitian matrix
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX array of dimension at least
+*> Y is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y. On exit, Y is overwritten by the updated
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is COMPLEX array of DIMENSION at least
+*> AP is COMPLEX array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the hermitian matrix
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is COMPLEX array of dimension at least
+*> Y is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is COMPLEX array of DIMENSION at least
+*> AP is COMPLEX array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the hermitian matrix
*> CROTG determines a complex Givens rotation.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] CA
+*> \verbatim
+*> CA is COMPLEX
+*> \endverbatim
+*>
+*> \param[in] CB
+*> \verbatim
+*> CB is COMPLEX
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*> C is REAL
+*> \endverbatim
+*>
+*> \param[out] S
+*> \verbatim
+*> S is COMPLEX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_blas_level1
*
* =====================================================================
SUBROUTINE CROTG(CA,CB,C,S)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
COMPLEX CA,CB,S
*> CSCAL scales a vector by a constant.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] CA
+*> \verbatim
+*> CA is COMPLEX
+*> On entry, CA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in,out] CX
+*> \verbatim
+*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of CX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_blas_level1
*
* =====================================================================
SUBROUTINE CSCAL(N,CA,CX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
COMPLEX CA
*> CSSCAL scales a complex vector by a real constant.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] SA
+*> \verbatim
+*> SA is REAL
+*> On entry, SA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in,out] CX
+*> \verbatim
+*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of CX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_blas_level1
*
* =====================================================================
SUBROUTINE CSSCAL(N,SA,CX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
REAL SA
*> CSWAP interchanges two vectors.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] CX
+*> \verbatim
+*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of CX
+*> \endverbatim
+*>
+*> \param[in,out] CY
+*> \verbatim
+*> CY is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of CY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_blas_level1
*
* =====================================================================
SUBROUTINE CSWAP(N,CX,INCX,CY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX array, dimension ( LDA, ka ), where ka is
*> m when SIDE = 'L' or 'l' and is n otherwise.
*> Before entry with SIDE = 'L' or 'l', the m by m part of
*> the array A must contain the symmetric matrix, such that
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX array of DIMENSION ( LDB, n ).
+*> B is COMPLEX array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B.
*> \endverbatim
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX array of DIMENSION ( LDC, n ).
+*> C is COMPLEX array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX array of DIMENSION ( LDB, kb ), where kb is
+*> B is COMPLEX array, dimension ( LDB, kb ), where kb is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX array of DIMENSION ( LDC, n ).
+*> C is COMPLEX array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX array of DIMENSION ( LDC, n ).
+*> C is COMPLEX array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N ).
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the matrix of coefficients, supplied column by
*>
*> \param[in,out] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the matrix of coefficients, supplied column by
*>
*> \param[in,out] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*>
*> \param[in] AP
*> \verbatim
-*> AP is COMPLEX array of DIMENSION at least
+*> AP is COMPLEX array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular matrix packed sequentially,
*>
*> \param[in,out] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] AP
*> \verbatim
-*> AP is COMPLEX array of DIMENSION at least
+*> AP is COMPLEX array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular matrix packed sequentially,
*>
*> \param[in,out] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, k ), where k is m
+*> A is COMPLEX array, dimension ( LDA, k ), where k is m
*> when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
*> Before entry with UPLO = 'U' or 'u', the leading k by k
*> upper triangular part of the array A must contain the upper
*>
*> \param[in,out] B
*> \verbatim
-*> B is COMPLEX array of DIMENSION ( LDB, n ).
+*> B is COMPLEX array, dimension ( LDB, N ).
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B, and on exit is overwritten by the
*> transformed matrix.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N ).
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular matrix and the strictly lower triangular part of
*>
*> \param[in,out] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, k ),
+*> A is COMPLEX array, dimension ( LDA, k ),
*> where k is m when SIDE = 'L' or 'l'
*> and k is n when SIDE = 'R' or 'r'.
*> Before entry with UPLO = 'U' or 'u', the leading k by k
*>
*> \param[in,out] B
*> \verbatim
-*> B is COMPLEX array of DIMENSION ( LDB, n ).
+*> B is COMPLEX array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the right-hand side matrix B, and on exit is
*> overwritten by the solution matrix X.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular matrix and the strictly lower triangular part of
*>
*> \param[in,out] X
*> \verbatim
-*> X is COMPLEX array of dimension at least
+*> X is COMPLEX array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*> DASUM takes the sum of the absolute values.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] DX
+*> \verbatim
+*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of DX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> uses unrolled loops for increments equal to one.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] DA
+*> \verbatim
+*> DA is DOUBLE PRECISION
+*> On entry, DA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] DX
+*> \verbatim
+*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of DX
+*> \endverbatim
+*>
+*> \param[in,out] DY
+*> \verbatim
+*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of DY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION DA
*> DCABS1 computes |Re(.)| + |Im(.)| of a double complex number
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] Z
+*> \verbatim
+*> Z is COMPLEX*16
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
DOUBLE PRECISION FUNCTION DCABS1(Z)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
COMPLEX*16 Z
*> \verbatim
*>
*> DCOPY copies a vector, x, to a vector, y.
-*> uses unrolled loops for increments equal to one.
+*> uses unrolled loops for increments equal to 1.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] DX
+*> \verbatim
+*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of DX
+*> \endverbatim
+*>
+*> \param[out] DY
+*> \verbatim
+*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of DY
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*> uses unrolled loops for increments equal to one.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] DX
+*> \verbatim
+*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of DX
+*> \endverbatim
+*>
+*> \param[in] DY
+*> \verbatim
+*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of DY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry, the leading ( kl + ku + 1 ) by n part of the
*> array A must contain the matrix of coefficients, supplied
*> column by column, with the leading diagonal of the matrix in
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of DIMENSION at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array of DIMENSION at least
+*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is
*> k when TRANSA = 'N' or 'n', and is m otherwise.
*> Before entry with TRANSA = 'N' or 'n', the leading m by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+*> B is DOUBLE PRECISION array, dimension ( LDB, kb ), where kb is
*> n when TRANSB = 'N' or 'n', and is k otherwise.
*> Before entry with TRANSB = 'N' or 'n', the leading k by n
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*> C is DOUBLE PRECISION array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> \endverbatim
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of DIMENSION at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array of DIMENSION at least
+*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the m
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array of dimension at least
+*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients. On exit, A is
*> overwritten by the updated matrix.
*> DNRM2 := sqrt( x'*x )
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*> X is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of DX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> DROT applies a plane rotation.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] DX
+*> \verbatim
+*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of DX
+*> \endverbatim
+*>
+*> \param[in,out] DY
+*> \verbatim
+*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of DY
+*> \endverbatim
+*>
+*> \param[in] C
+*> \verbatim
+*> C is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] S
+*> \verbatim
+*> S is DOUBLE PRECISION
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION C,S
*> DROTG construct givens plane rotation.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] DA
+*> \verbatim
+*> DA is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] DB
+*> \verbatim
+*> DB is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*> C is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[out] S
+*> \verbatim
+*> S is DOUBLE PRECISION
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
SUBROUTINE DROTG(DA,DB,C,S)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION C,DA,DB,S
*>
*> \param[in,out] DX
*> \verbatim
-*> DX is DOUBLE PRECISION array, dimension N
-*> double precision vector with N elements
+*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*>
*> \param[in,out] DY
*> \verbatim
-*> DY is DOUBLE PRECISION array, dimension N
-*> double precision vector with N elements
+*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> storage spacing between elements of DY
*> \endverbatim
*>
-*> \param[in,out] DPARAM
+*> \param[in] DPARAM
*> \verbatim
-*> DPARAM is DOUBLE PRECISION array, dimension 5
+*> DPARAM is DOUBLE PRECISION array, dimension (5)
*> DPARAM(1)=DFLAG
*> DPARAM(2)=DH11
*> DPARAM(3)=DH21
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*> DY1 is DOUBLE PRECISION
*> \endverbatim
*>
-*> \param[in,out] DPARAM
+*> \param[out] DPARAM
*> \verbatim
-*> DPARAM is DOUBLE PRECISION array, dimension 5
+*> DPARAM is DOUBLE PRECISION array, dimension (5)
*> DPARAM(1)=DFLAG
*> DPARAM(2)=DH11
*> DPARAM(3)=DH21
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION DD1,DD2,DX1,DY1
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the symmetric matrix, supplied column by
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of DIMENSION at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the
*> vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array of DIMENSION at least
+*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the
*> vector y. On exit, Y is overwritten by the updated vector y.
*> \verbatim
*>
*> DSCAL scales a vector by a constant.
-*> uses unrolled loops for increment equal to one.
+*> uses unrolled loops for increment equal to 1.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] DA
+*> \verbatim
+*> DA is DOUBLE PRECISION
+*> On entry, DA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in,out] DX
+*> \verbatim
+*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of DX
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
SUBROUTINE DSCAL(N,DA,DX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION DA
*>
*> \param[in] AP
*> \verbatim
-*> AP is DOUBLE PRECISION array of DIMENSION at least
+*> AP is DOUBLE PRECISION array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the symmetric matrix
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array of dimension at least
+*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y. On exit, Y is overwritten by the updated
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is DOUBLE PRECISION array of DIMENSION at least
+*> AP is DOUBLE PRECISION array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the symmetric matrix
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array of dimension at least
+*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is DOUBLE PRECISION array of DIMENSION at least
+*> AP is DOUBLE PRECISION array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the symmetric matrix
*>
*> \verbatim
*>
-*> interchanges two vectors.
-*> uses unrolled loops for increments equal one.
+*> DSWAP interchanges two vectors.
+*> uses unrolled loops for increments equal to 1.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] DX
+*> \verbatim
+*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of DX
+*> \endverbatim
+*>
+*> \param[in,out] DY
+*> \verbatim
+*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of DY
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is
*> m when SIDE = 'L' or 'l' and is n otherwise.
*> Before entry with SIDE = 'L' or 'l', the m by m part of
*> the array A must contain the symmetric matrix, such that
*>
*> \param[in] B
*> \verbatim
-*> B is DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+*> B is DOUBLE PRECISION array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B.
*> \endverbatim
*>
*> \param[in,out] C
*> \verbatim
-*> C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*> C is DOUBLE PRECISION array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array of dimension at least
+*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y. On exit, Y is overwritten by the updated
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array of dimension at least
+*> Y is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+*> B is DOUBLE PRECISION array, dimension ( LDB, kb ), where kb is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*> C is DOUBLE PRECISION array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*> C is DOUBLE PRECISION array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the matrix of coefficients, supplied column by
*>
*> \param[in,out] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the matrix of coefficients, supplied column by
*>
*> \param[in,out] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*>
*> \param[in] AP
*> \verbatim
-*> AP is DOUBLE PRECISION array of DIMENSION at least
+*> AP is DOUBLE PRECISION array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular matrix packed sequentially,
*>
*> \param[in,out] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] AP
*> \verbatim
-*> AP is DOUBLE PRECISION array of DIMENSION at least
+*> AP is DOUBLE PRECISION array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular matrix packed sequentially,
*>
*> \param[in,out] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+*> A is DOUBLE PRECISION array, dimension ( LDA, k ), where k is m
*> when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
*> Before entry with UPLO = 'U' or 'u', the leading k by k
*> upper triangular part of the array A must contain the upper
*>
*> \param[in,out] B
*> \verbatim
-*> B is DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+*> B is DOUBLE PRECISION array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B, and on exit is overwritten by the
*> transformed matrix.
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular matrix and the strictly lower triangular part of
*>
*> \param[in,out] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, k ),
+*> A is DOUBLE PRECISION array, dimension ( LDA, k ),
*> where k is m when SIDE = 'L' or 'l'
*> and k is n when SIDE = 'R' or 'r'.
*> Before entry with UPLO = 'U' or 'u', the leading k by k
*>
*> \param[in,out] B
*> \verbatim
-*> B is DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+*> B is DOUBLE PRECISION array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the right-hand side matrix B, and on exit is
*> overwritten by the solution matrix X.
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular matrix and the strictly lower triangular part of
*>
*> \param[in,out] X
*> \verbatim
-*> X is DOUBLE PRECISION array of dimension at least
+*> X is DOUBLE PRECISION array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*> returns a single precision result.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] ZX
+*> \verbatim
+*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of ZX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> DZNRM2 := sqrt( x**H*x )
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*> X is COMPLEX*16 array, dimension (N)
+*> complex vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of X
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_blas_level1
*
* =====================================================================
DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> ICAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)|
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] CX
+*> \verbatim
+*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup aux_blas
*
* =====================================================================
INTEGER FUNCTION ICAMAX(N,CX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> IDAMAX finds the index of the first element having maximum absolute value.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] DX
+*> \verbatim
+*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup aux_blas
*
* =====================================================================
INTEGER FUNCTION IDAMAX(N,DX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> ISAMAX finds the index of the first element having maximum absolute value.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] SX
+*> \verbatim
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup aux_blas
*
* =====================================================================
INTEGER FUNCTION ISAMAX(N,SX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> IZAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)|
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] ZX
+*> \verbatim
+*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup aux_blas
*
* =====================================================================
INTEGER FUNCTION IZAMAX(N,ZX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> uses unrolled loops for increment equal to one.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] SX
+*> \verbatim
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
REAL FUNCTION SASUM(N,SX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> uses unrolled loops for increments equal to one.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] SA
+*> \verbatim
+*> SA is REAL
+*> On entry, SA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] SX
+*> \verbatim
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*>
+*> \param[in,out] SY
+*> \verbatim
+*> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of SY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
REAL SA
*> SCABS1 computes |Re(.)| + |Im(.)| of a complex number
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] Z
+*> \verbatim
+*> Z is COMPLEX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
REAL FUNCTION SCABS1(Z)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
COMPLEX Z
*> returns a single precision result.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] CX
+*> \verbatim
+*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
REAL FUNCTION SCASUM(N,CX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> SCNRM2 := sqrt( x**H*x )
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*> X is COMPLEX array, dimension (N)
+*> complex vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of X
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
REAL FUNCTION SCNRM2(N,X,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> uses unrolled loops for increments equal to 1.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] SX
+*> \verbatim
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*>
+*> \param[out] SY
+*> \verbatim
+*> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of SY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
SUBROUTINE SCOPY(N,SX,INCX,SY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*> uses unrolled loops for increments equal to one.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] SX
+*> \verbatim
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*>
+*> \param[in] SY
+*> \verbatim
+*> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of SY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
REAL FUNCTION SDOT(N,SX,INCX,SY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
* REAL SX(*),SY(*)
* ..
*
-* PURPOSE
-* =======
-*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
* Compute the inner product of two vectors with extended
* precision accumulation.
*
* SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
* defined in a similar way using INCY.
+*> \endverbatim
*
-* AUTHOR
-* ======
-* Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
-* Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
-*
-* ARGUMENTS
-* =========
-*
-* N (input) INTEGER
-* number of elements in input vector(s)
-*
-* SB (input) REAL
-* single precision scalar to be added to inner product
-*
-* SX (input) REAL array, dimension (N)
-* single precision vector with N elements
-*
-* INCX (input) INTEGER
-* storage spacing between elements of SX
-*
-* SY (input) REAL array, dimension (N)
-* single precision vector with N elements
-*
-* INCY (input) INTEGER
-* storage spacing between elements of SY
-*
-* SDSDOT (output) REAL
-* single precision dot product (SB if N .LE. 0)
+* Arguments:
+* ==========
*
-* Further Details
-* ===============
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] SB
+*> \verbatim
+*> SB is REAL
+*> single precision scalar to be added to inner product
+*> \endverbatim
+*>
+*> \param[in] SX
+*> \verbatim
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> single precision vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*>
+*> \param[in] SY
+*> \verbatim
+*> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> single precision vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of SY
+*> \endverbatim
*
-* REFERENCES
+* Authors:
+* ========
*
-* C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
-* Krogh, Basic linear algebra subprograms for Fortran
-* usage, Algorithm No. 539, Transactions on Mathematical
-* Software 5, 3 (September 1979), pp. 308-323.
+*> \author Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
+*> \author Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
*
-* REVISION HISTORY (YYMMDD)
+*> \ingroup complex_blas_level1
*
-* 791001 DATE WRITTEN
-* 890531 Changed all specific intrinsics to generic. (WRB)
-* 890831 Modified array declarations. (WRB)
-* 890831 REVISION DATE from Version 3.2
-* 891214 Prologue converted to Version 4.0 format. (BAB)
-* 920310 Corrected definition of LX in DESCRIPTION. (WRB)
-* 920501 Reformatted the REFERENCES section. (WRB)
-* 070118 Reformat to LAPACK coding style
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> REFERENCES
+*>
+*> C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+*> Krogh, Basic linear algebra subprograms for Fortran
+*> usage, Algorithm No. 539, Transactions on Mathematical
+*> Software 5, 3 (September 1979), pp. 308-323.
+*>
+*> REVISION HISTORY (YYMMDD)
+*>
+*> 791001 DATE WRITTEN
+*> 890531 Changed all specific intrinsics to generic. (WRB)
+*> 890831 Modified array declarations. (WRB)
+*> 890831 REVISION DATE from Version 3.2
+*> 891214 Prologue converted to Version 4.0 format. (BAB)
+*> 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+*> 920501 Reformatted the REFERENCES section. (WRB)
+*> 070118 Reformat to LAPACK coding style
+*> \endverbatim
*
* =====================================================================
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
REAL SB
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry, the leading ( kl + ku + 1 ) by n part of the
*> array A must contain the matrix of coefficients, supplied
*> column by column, with the leading diagonal of the matrix in
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of DIMENSION at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is REAL array of DIMENSION at least
+*> Y is REAL array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, ka ), where ka is
+*> A is REAL array, dimension ( LDA, ka ), where ka is
*> k when TRANSA = 'N' or 'n', and is m otherwise.
*> Before entry with TRANSA = 'N' or 'n', the leading m by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is REAL array of DIMENSION ( LDB, kb ), where kb is
+*> B is REAL array, dimension ( LDB, kb ), where kb is
*> n when TRANSB = 'N' or 'n', and is k otherwise.
*> Before entry with TRANSB = 'N' or 'n', the leading k by n
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is REAL array of DIMENSION ( LDC, n ).
+*> C is REAL array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> \endverbatim
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of DIMENSION at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is REAL array of DIMENSION at least
+*> Y is REAL array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the m
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is REAL array of dimension at least
+*> Y is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients. On exit, A is
*> overwritten by the updated matrix.
*> SNRM2 := sqrt( x'*x ).
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*> X is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
REAL FUNCTION SNRM2(N,X,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
*> applies a plane rotation.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] SX
+*> \verbatim
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*>
+*> \param[in,out] SY
+*> \verbatim
+*> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of SY
+*> \endverbatim
+*>
+*> \param[in] C
+*> \verbatim
+*> C is REAL
+*> \endverbatim
+*>
+*> \param[in] S
+*> \verbatim
+*> S is REAL
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
REAL C,S
*> SROTG construct givens plane rotation.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] SA
+*> \verbatim
+*> SA is REAL
+*> \endverbatim
+*>
+*> \param[in] SB
+*> \verbatim
+*> SB is REAL
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*> C is REAL
+*> \endverbatim
+*>
+*> \param[out] S
+*> \verbatim
+*> S is REAL
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
SUBROUTINE SROTG(SA,SB,C,S)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
REAL C,S,SA,SB
*>
*> \param[in,out] SX
*> \verbatim
-*> SX is REAL array, dimension N
-*> double precision vector with N elements
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*>
*> \param[in,out] SY
*> \verbatim
-*> SY is REAL array, dimension N
-*> double precision vector with N elements
+*> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> storage spacing between elements of SY
*> \endverbatim
*>
-*> \param[in,out] SPARAM
+*> \param[in] SPARAM
*> \verbatim
-*> SPARAM is REAL array, dimension 5
+*> SPARAM is REAL array, dimension (5)
*> SPARAM(1)=SFLAG
*> SPARAM(2)=SH11
*> SPARAM(3)=SH21
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*> SY1 is REAL
*> \endverbatim
*>
-*> \param[in,out] SPARAM
+*> \param[out] SPARAM
*> \verbatim
-*> SPARAM is REAL array, dimension 5
+*> SPARAM is REAL array, dimension (5)
*> SPARAM(1)=SFLAG
*> SPARAM(2)=SH11
*> SPARAM(3)=SH21
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
REAL SD1,SD2,SX1,SY1
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the symmetric matrix, supplied column by
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of DIMENSION at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the
*> vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is REAL array of DIMENSION at least
+*> Y is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the
*> vector y. On exit, Y is overwritten by the updated vector y.
*>
*> \verbatim
*>
-*> scales a vector by a constant.
+*> SSCAL scales a vector by a constant.
*> uses unrolled loops for increment equal to 1.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] SA
+*> \verbatim
+*> SA is REAL
+*> On entry, SA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in,out] SX
+*> \verbatim
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
SUBROUTINE SSCAL(N,SA,SX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
REAL SA
*>
*> \param[in] AP
*> \verbatim
-*> AP is REAL array of DIMENSION at least
+*> AP is REAL array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the symmetric matrix
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is REAL array of dimension at least
+*> Y is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y. On exit, Y is overwritten by the updated
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is REAL array of DIMENSION at least
+*> AP is REAL array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the symmetric matrix
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is REAL array of dimension at least
+*> Y is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is REAL array of DIMENSION at least
+*> AP is REAL array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the symmetric matrix
*>
*> \verbatim
*>
-*> interchanges two vectors.
+*> SSWAP interchanges two vectors.
*> uses unrolled loops for increments equal to 1.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] SX
+*> \verbatim
+*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of SX
+*> \endverbatim
+*>
+*> \param[in,out] SY
+*> \verbatim
+*> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of SY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_blas_level1
*
* =====================================================================
SUBROUTINE SSWAP(N,SX,INCX,SY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, ka ), where ka is
+*> A is REAL array, dimension ( LDA, ka ), where ka is
*> m when SIDE = 'L' or 'l' and is n otherwise.
*> Before entry with SIDE = 'L' or 'l', the m by m part of
*> the array A must contain the symmetric matrix, such that
*>
*> \param[in] B
*> \verbatim
-*> B is REAL array of DIMENSION ( LDB, n ).
+*> B is REAL array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B.
*> \endverbatim
*>
*> \param[in,out] C
*> \verbatim
-*> C is REAL array of DIMENSION ( LDC, n ).
+*> C is REAL array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is REAL array of dimension at least
+*> Y is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y. On exit, Y is overwritten by the updated
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is REAL array of dimension at least
+*> Y is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, ka ), where ka is
+*> A is REAL array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is REAL array of DIMENSION ( LDB, kb ), where kb is
+*> B is REAL array, dimension ( LDB, kb ), where kb is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is REAL array of DIMENSION ( LDC, n ).
+*> C is REAL array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, ka ), where ka is
+*> A is REAL array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is REAL array of DIMENSION ( LDC, n ).
+*> C is REAL array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the matrix of coefficients, supplied column by
*>
*> \param[in,out] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the matrix of coefficients, supplied column by
*>
*> \param[in,out] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*>
*> \param[in] AP
*> \verbatim
-*> AP is REAL array of DIMENSION at least
+*> AP is REAL array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular matrix packed sequentially,
*>
*> \param[in,out] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] AP
*> \verbatim
-*> AP is REAL array of DIMENSION at least
+*> AP is REAL array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular matrix packed sequentially,
*>
*> \param[in,out] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, k ), where k is m
+*> A is REAL array, dimension ( LDA, k ), where k is m
*> when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
*> Before entry with UPLO = 'U' or 'u', the leading k by k
*> upper triangular part of the array A must contain the upper
*>
*> \param[in,out] B
*> \verbatim
-*> B is REAL array of DIMENSION ( LDB, n ).
+*> B is REAL array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B, and on exit is overwritten by the
*> transformed matrix.
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular matrix and the strictly lower triangular part of
*>
*> \param[in,out] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, k ),
+*> A is REAL array, dimension ( LDA, k ),
*> where k is m when SIDE = 'L' or 'l'
*> and k is n when SIDE = 'R' or 'r'.
*> Before entry with UPLO = 'U' or 'u', the leading k by k
*>
*> \param[in,out] B
*> \verbatim
-*> B is REAL array of DIMENSION ( LDB, n ).
+*> B is REAL array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the right-hand side matrix B, and on exit is
*> overwritten by the solution matrix X.
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular matrix and the strictly lower triangular part of
*>
*> \param[in,out] X
*> \verbatim
-*> X is REAL array of dimension at least
+*> X is REAL array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*> ZAXPY constant times a vector plus a vector.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] ZA
+*> \verbatim
+*> ZA is COMPLEX*16
+*> On entry, ZA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] ZX
+*> \verbatim
+*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of ZX
+*> \endverbatim
+*>
+*> \param[in,out] ZY
+*> \verbatim
+*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of ZY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_blas_level1
*
* =====================================================================
SUBROUTINE ZAXPY(N,ZA,ZX,INCX,ZY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
COMPLEX*16 ZA
*> ZCOPY copies a vector, x, to a vector, y.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] ZX
+*> \verbatim
+*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of ZX
+*> \endverbatim
+*>
+*> \param[out] ZY
+*> \verbatim
+*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of ZY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_blas_level1
*
* =====================================================================
SUBROUTINE ZCOPY(N,ZX,INCX,ZY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] ZX
+*> \verbatim
+*> ZX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of ZX
+*> \endverbatim
+*>
+*> \param[in] ZY
+*> \verbatim
+*> ZY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of ZY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_blas_level1
*
* =====================================================================
COMPLEX*16 FUNCTION ZDOTC(N,ZX,INCX,ZY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] ZX
+*> \verbatim
+*> ZX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of ZX
+*> \endverbatim
+*>
+*> \param[in] ZY
+*> \verbatim
+*> ZY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of ZY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_blas_level1
*
* =====================================================================
COMPLEX*16 FUNCTION ZDOTU(N,ZX,INCX,ZY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*> ZDSCAL scales a vector by a constant.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] DA
+*> \verbatim
+*> DA is DOUBLE PRECISION
+*> On entry, DA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in,out] ZX
+*> \verbatim
+*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of ZX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_blas_level1
*
* =====================================================================
SUBROUTINE ZDSCAL(N,DA,ZX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION DA
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry, the leading ( kl + ku + 1 ) by n part of the
*> array A must contain the matrix of coefficients, supplied
*> column by column, with the leading diagonal of the matrix in
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of DIMENSION at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX*16 array of DIMENSION at least
+*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
*> k when TRANSA = 'N' or 'n', and is m otherwise.
*> Before entry with TRANSA = 'N' or 'n', the leading m by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is
+*> B is COMPLEX*16 array, dimension ( LDB, kb ), where kb is
*> n when TRANSB = 'N' or 'n', and is k otherwise.
*> Before entry with TRANSB = 'N' or 'n', the leading k by n
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX*16 array of DIMENSION ( LDC, n ).
+*> C is COMPLEX*16 array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> \endverbatim
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of DIMENSION at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX*16 array of DIMENSION at least
+*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the m
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is COMPLEX*16 array of dimension at least
+*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients. On exit, A is
*> overwritten by the updated matrix.
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( m - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the m
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is COMPLEX*16 array of dimension at least
+*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients. On exit, A is
*> overwritten by the updated matrix.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the hermitian matrix, supplied column by
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of DIMENSION at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the
*> vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX*16 array of DIMENSION at least
+*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the
*> vector y. On exit, Y is overwritten by the updated vector y.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
*> m when SIDE = 'L' or 'l' and is n otherwise.
*> Before entry with SIDE = 'L' or 'l', the m by m part of
*> the array A must contain the hermitian matrix, such that
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX*16 array of DIMENSION ( LDB, n ).
+*> B is COMPLEX*16 array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B.
*> \endverbatim
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX*16 array of DIMENSION ( LDC, n ).
+*> C is COMPLEX*16 array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX*16 array of dimension at least
+*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y. On exit, Y is overwritten by the updated
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is COMPLEX*16 array of dimension at least
+*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is
+*> B is COMPLEX*16 array, dimension ( LDB, kb ), where kb is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX*16 array of DIMENSION ( LDC, n ).
+*> C is COMPLEX*16 array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX*16 array of DIMENSION ( LDC, n ).
+*> C is COMPLEX*16 array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the hermitian matrix and the strictly
*>
*> \param[in] AP
*> \verbatim
-*> AP is COMPLEX*16 array of DIMENSION at least
+*> AP is COMPLEX*16 array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the hermitian matrix
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX*16 array of dimension at least
+*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y. On exit, Y is overwritten by the updated
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is COMPLEX*16 array of DIMENSION at least
+*> AP is COMPLEX*16 array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the hermitian matrix
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x.
*>
*> \param[in] Y
*> \verbatim
-*> Y is COMPLEX*16 array of dimension at least
+*> Y is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCY ) ).
*> Before entry, the incremented array Y must contain the n
*> element vector y.
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is COMPLEX*16 array of DIMENSION at least
+*> AP is COMPLEX*16 array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular part of the hermitian matrix
*> ZROTG determines a double complex Givens rotation.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] CA
+*> \verbatim
+*> CA is COMPLEX*16
+*> \endverbatim
+*>
+*> \param[in] CB
+*> \verbatim
+*> CB is COMPLEX*16
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*> C is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[out] S
+*> \verbatim
+*> S is COMPLEX*16
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_blas_level1
*
* =====================================================================
SUBROUTINE ZROTG(CA,CB,C,S)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
COMPLEX*16 CA,CB,S
*> ZSCAL scales a vector by a constant.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] ZA
+*> \verbatim
+*> ZA is COMPLEX*16
+*> On entry, ZA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in,out] ZX
+*> \verbatim
+*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of ZX
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_blas_level1
*
* =====================================================================
SUBROUTINE ZSCAL(N,ZA,ZX,INCX)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
COMPLEX*16 ZA
*> ZSWAP interchanges two vectors.
*> \endverbatim
*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] ZX
+*> \verbatim
+*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> storage spacing between elements of ZX
+*> \endverbatim
+*>
+*> \param[in,out] ZY
+*> \verbatim
+*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*> INCY is INTEGER
+*> storage spacing between elements of ZY
+*> \endverbatim
+*
* Authors:
* ========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_blas_level1
*
* =====================================================================
SUBROUTINE ZSWAP(N,ZX,INCX,ZY,INCY)
*
-* -- Reference BLAS level1 routine (version 3.7.0) --
+* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,INCY,N
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
*> m when SIDE = 'L' or 'l' and is n otherwise.
*> Before entry with SIDE = 'L' or 'l', the m by m part of
*> the array A must contain the symmetric matrix, such that
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX*16 array of DIMENSION ( LDB, n ).
+*> B is COMPLEX*16 array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B.
*> \endverbatim
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX*16 array of DIMENSION ( LDC, n ).
+*> C is COMPLEX*16 array, dimension ( LDC, N )
*> Before entry, the leading m by n part of the array C must
*> contain the matrix C, except when beta is zero, in which
*> case C need not be set on entry.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in] B
*> \verbatim
-*> B is COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is
+*> B is COMPLEX*16 array, dimension ( LDB, kb ), where kb is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array B must contain the matrix B, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX*16 array of DIMENSION ( LDC, n ).
+*> C is COMPLEX*16 array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is
*> k when TRANS = 'N' or 'n', and is n otherwise.
*> Before entry with TRANS = 'N' or 'n', the leading n by k
*> part of the array A must contain the matrix A, otherwise
*>
*> \param[in,out] C
*> \verbatim
-*> C is COMPLEX*16 array of DIMENSION ( LDC, n ).
+*> C is COMPLEX*16 array, dimension ( LDC, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array C must contain the upper
*> triangular part of the symmetric matrix and the strictly
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N ).
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the matrix of coefficients, supplied column by
*> ( k + 1 ).
*> \endverbatim
*>
-*> \param[in] X
+*> \param[in,out] X
*> \verbatim
-*> X is (input/output) COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
*> by n part of the array A must contain the upper triangular
*> band part of the matrix of coefficients, supplied column by
*>
*> \param[in,out] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*>
*> \param[in] AP
*> \verbatim
-*> AP is COMPLEX*16 array of DIMENSION at least
+*> AP is COMPLEX*16 array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular matrix packed sequentially,
*> A are not referenced, but are assumed to be unity.
*> \endverbatim
*>
-*> \param[in] X
+*> \param[in,out] X
*> \verbatim
-*> X is (input/output) COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] AP
*> \verbatim
-*> AP is COMPLEX*16 array of DIMENSION at least
+*> AP is COMPLEX*16 array, dimension at least
*> ( ( n*( n + 1 ) )/2 ).
*> Before entry with UPLO = 'U' or 'u', the array AP must
*> contain the upper triangular matrix packed sequentially,
*>
*> \param[in,out] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m
+*> A is COMPLEX*16 array, dimension ( LDA, k ), where k is m
*> when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
*> Before entry with UPLO = 'U' or 'u', the leading k by k
*> upper triangular part of the array A must contain the upper
*> then LDA must be at least max( 1, n ).
*> \endverbatim
*>
-*> \param[in] B
+*> \param[in,out] B
*> \verbatim
-*> B is (input/output) COMPLEX*16 array of DIMENSION ( LDB, n ).
+*> B is COMPLEX*16 array, dimension ( LDB, N ).
*> Before entry, the leading m by n part of the array B must
*> contain the matrix B, and on exit is overwritten by the
*> transformed matrix.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N ).
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular matrix and the strictly lower triangular part of
*> max( 1, n ).
*> \endverbatim
*>
-*> \param[in] X
+*> \param[in,out] X
*> \verbatim
-*> X is (input/output) COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element vector x. On exit, X is overwritten with the
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, k ),
+*> A is COMPLEX*16 array, dimension ( LDA, k ),
*> where k is m when SIDE = 'L' or 'l'
*> and k is n when SIDE = 'R' or 'r'.
*> Before entry with UPLO = 'U' or 'u', the leading k by k
*>
*> \param[in,out] B
*> \verbatim
-*> B is COMPLEX*16 array of DIMENSION ( LDB, n ).
+*> B is COMPLEX*16 array, dimension ( LDB, N )
*> Before entry, the leading m by n part of the array B must
*> contain the right-hand side matrix B, and on exit is
*> overwritten by the solution matrix X.
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, N )
*> Before entry with UPLO = 'U' or 'u', the leading n by n
*> upper triangular part of the array A must contain the upper
*> triangular matrix and the strictly lower triangular part of
*>
*> \param[in,out] X
*> \verbatim
-*> X is COMPLEX*16 array of dimension at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ).
*> Before entry, the incremented array X must contain the n
*> element right-hand side vector b. On exit, X is overwritten
-#######################################################################
-# This makefile creates the test programs for the BLAS 1 routines.
-# The test files are grouped as follows:
-# SBLAT1 -- Single precision real test routines
-# CBLAT1 -- Single precision complex test routines
-# DBLAT1 -- Double precision real test routines
-# ZBLAT1 -- Double precision complex test routines
-#
-# Test programs can be generated for all or some of the four different
-# precisions. To create the test programs, enter make followed by one
-# or more of the precisions desired. Some examples:
-# make single
-# make single complex
-# make single double complex complex16
-# Alternatively, the command
-# make
-# without any arguments creates all four test programs.
-# The executable files which are created are called
-# ../xblat1s, ../xblat1d, ../xblat1c, and ../xblat1z
-#
-# To remove the object files after the executable files have been
-# created, enter
-# make clean
-# To force the source files to be recompiled, enter, for example,
-# make single FRC=FRC
-#
-#######################################################################
-
macro(add_blas_test name src)
get_filename_component(baseNAME ${src} NAME_WE)
- set(TEST_INPUT "${LAPACK_SOURCE_DIR}/BLAS/${baseNAME}.in")
+ set(TEST_INPUT "${CMAKE_CURRENT_SOURCE_DIR}/${baseNAME}.in")
add_executable(${name} ${src})
target_link_libraries(${name} blas)
if(EXISTS "${TEST_INPUT}")
+++ /dev/null
-include ../../make.inc
-
-#######################################################################
-# This makefile creates the test programs for the BLAS 1 routines.
-# The test files are grouped as follows:
-# SBLAT1 -- Single precision real test routines
-# CBLAT1 -- Single precision complex test routines
-# DBLAT1 -- Double precision real test routines
-# ZBLAT1 -- Double precision complex test routines
-#
-# Test programs can be generated for all or some of the four different
-# precisions. To create the test programs, enter make followed by one
-# or more of the precisions desired. Some examples:
-# make single
-# make single complex
-# make single double complex complex16
-# Alternatively, the command
-# make
-# without any arguments creates all four test programs.
-# The executable files which are created are called
-# ../xblat1s, ../xblat1d, ../xblat1c, and ../xblat1z
-#
-# To remove the object files after the executable files have been
-# created, enter
-# make clean
-# To force the source files to be recompiled, enter, for example,
-# make single FRC=FRC
-#
-#######################################################################
-
-SBLAT1 = sblat1.o
-CBLAT1 = cblat1.o
-DBLAT1 = dblat1.o
-ZBLAT1 = zblat1.o
-
-all: single double complex complex16
-
-single: ../xblat1s
-double: ../xblat1d
-complex: ../xblat1c
-complex16: ../xblat1z
-
-../xblat1s: $(SBLAT1)
- $(LOADER) $(LOADOPTS) -o $@ $(SBLAT1) $(BLASLIB)
-
-../xblat1c: $(CBLAT1)
- $(LOADER) $(LOADOPTS) -o $@ $(CBLAT1) $(BLASLIB)
-
-../xblat1d: $(DBLAT1)
- $(LOADER) $(LOADOPTS) -o $@ $(DBLAT1) $(BLASLIB)
-
-../xblat1z: $(ZBLAT1)
- $(LOADER) $(LOADOPTS) -o $@ $(ZBLAT1) $(BLASLIB)
-
-$(SBLAT1): $(FRC)
-$(CBLAT1): $(FRC)
-$(DBLAT1): $(FRC)
-$(ZBLAT1): $(FRC)
-
-FRC:
- @FRC=$(FRC)
-
-clean:
- rm -f *.o
-
-.f.o:
- $(FORTRAN) $(OPTS) -c -o $@ $<
+++ /dev/null
-include ../../make.inc
-
-#######################################################################
-# This makefile creates the test programs for the BLAS 2 routines.
-# The test files are grouped as follows:
-# SBLAT2 -- Single precision real test routines
-# CBLAT2 -- Single precision complex test routines
-# DBLAT2 -- Double precision real test routines
-# ZBLAT2 -- Double precision complex test routines
-#
-# Test programs can be generated for all or some of the four different
-# precisions. To create the test programs, enter make followed by one
-# or more of the precisions desired. Some examples:
-# make single
-# make single complex
-# make single double complex complex16
-# Alternatively, the command
-# make
-# without any arguments creates all four test programs.
-# The executable files which are created are called
-# ../xblat2s, ../xblat2d, ../xblat2c, and ../xblat2z
-#
-# To remove the object files after the executable files have been
-# created, enter
-# make clean
-# To force the source files to be recompiled, enter, for example,
-# make single FRC=FRC
-#
-#######################################################################
-
-SBLAT2 = sblat2.o
-CBLAT2 = cblat2.o
-DBLAT2 = dblat2.o
-ZBLAT2 = zblat2.o
-
-all: single double complex complex16
-
-single: ../xblat2s
-double: ../xblat2d
-complex: ../xblat2c
-complex16: ../xblat2z
-
-../xblat2s: $(SBLAT2)
- $(LOADER) $(LOADOPTS) -o $@ $(SBLAT2) $(BLASLIB)
-
-../xblat2c: $(CBLAT2)
- $(LOADER) $(LOADOPTS) -o $@ $(CBLAT2) $(BLASLIB)
-
-../xblat2d: $(DBLAT2)
- $(LOADER) $(LOADOPTS) -o $@ $(DBLAT2) $(BLASLIB)
-
-../xblat2z: $(ZBLAT2)
- $(LOADER) $(LOADOPTS) -o $@ $(ZBLAT2) $(BLASLIB)
-
-$(SBLAT2): $(FRC)
-$(CBLAT2): $(FRC)
-$(DBLAT2): $(FRC)
-$(ZBLAT2): $(FRC)
-
-FRC:
- @FRC=$(FRC)
-
-clean:
- rm -f *.o
-
-.f.o:
- $(FORTRAN) $(OPTS) -c -o $@ $<
+++ /dev/null
-include ../../make.inc
-
-#######################################################################
-# This makefile creates the test programs for the BLAS 3 routines.
-# The test files are grouped as follows:
-# SBLAT3 -- Single precision real test routines
-# CBLAT3 -- Single precision complex test routines
-# DBLAT3 -- Double precision real test routines
-# ZBLAT3 -- Double precision complex test routines
-#
-# Test programs can be generated for all or some of the four different
-# precisions. To create the test programs, enter make followed by one
-# or more of the precisions desired. Some examples:
-# make single
-# make single complex
-# make single double complex complex16
-# Alternatively, the command
-# make
-# without any arguments creates all four test programs.
-# The executable files which are created are called
-# ../xblat3s, ../xblat3d, ../xblat3c, and ../xblat3z
-#
-# To remove the object files after the executable files have been
-# created, enter
-# make clean
-# To force the source files to be recompiled, enter, for example,
-# make single FRC=FRC
-#
-#######################################################################
-
-SBLAT3 = sblat3.o
-CBLAT3 = cblat3.o
-DBLAT3 = dblat3.o
-ZBLAT3 = zblat3.o
-
-all: single double complex complex16
-
-single: ../xblat3s
-double: ../xblat3d
-complex: ../xblat3c
-complex16: ../xblat3z
-
-../xblat3s: $(SBLAT3)
- $(LOADER) $(LOADOPTS) -o $@ $(SBLAT3) $(BLASLIB)
-
-../xblat3c: $(CBLAT3)
- $(LOADER) $(LOADOPTS) -o $@ $(CBLAT3) $(BLASLIB)
-
-../xblat3d: $(DBLAT3)
- $(LOADER) $(LOADOPTS) -o $@ $(DBLAT3) $(BLASLIB)
-
-../xblat3z: $(ZBLAT3)
- $(LOADER) $(LOADOPTS) -o $@ $(ZBLAT3) $(BLASLIB)
-
-$(SBLAT3): $(FRC)
-$(CBLAT3): $(FRC)
-$(DBLAT3): $(FRC)
-$(ZBLAT3): $(FRC)
-
-FRC:
- @FRC=$(FRC)
-
-clean:
- rm -f *.o
-
-.f.o:
- $(FORTRAN) $(OPTS) -c -o $@ $<
--- /dev/null
+include ../../make.inc
+
+all: single double complex complex16
+single: xblat1s xblat2s xblat3s
+double: xblat1d xblat2d xblat3d
+complex: xblat1c xblat2c xblat3c
+complex16: xblat1z xblat2z xblat3z
+
+xblat1s: sblat1.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xblat1d: dblat1.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xblat1c: cblat1.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xblat1z: zblat1.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+
+xblat2s: sblat2.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xblat2d: dblat2.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xblat2c: cblat2.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xblat2z: zblat2.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+
+xblat3s: sblat3.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xblat3d: dblat3.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xblat3c: cblat3.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xblat3z: zblat3.o $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+
+run: all
+ ./xblat1s > sblat1.out
+ ./xblat1d > dblat1.out
+ ./xblat1c > cblat1.out
+ ./xblat1z > zblat1.out
+ ./xblat2s < sblat2.in
+ ./xblat2d < dblat2.in
+ ./xblat2c < cblat2.in
+ ./xblat2z < zblat2.in
+ ./xblat3s < sblat3.in
+ ./xblat3d < dblat3.in
+ ./xblat3c < cblat3.in
+ ./xblat3z < zblat3.in
+
+clean: cleanobj cleanexe cleantest
+cleanobj:
+ rm -f *.o
+cleanexe:
+ rm -f xblat*
+cleantest:
+ rm -f *.out core
+
+.f.o:
+ $(FORTRAN) $(OPTS) -c -o $@ $<
* =====================================================================
PROGRAM DBLAT1
*
-* -- Reference BLAS test routine (version 3.7.0) --
+* -- Reference BLAS test routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
$ DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
* .. External Subroutines ..
- EXTERNAL DROTG, DROTMG, STEST1
+ EXTERNAL DROTG, DROTMG, STEST, STEST1
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DOUBLE PRECISION DDOT, DSDOT
EXTERNAL DDOT, DSDOT
* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DROTM, DSWAP, STEST, STEST1
+ EXTERNAL DAXPY, DCOPY, DROTM, DSWAP, STEST, STEST1,
+ $ TESTDSDOT
* .. Intrinsic Functions ..
INTRINSIC ABS, MIN
* .. Common blocks ..
* =====================================================================
PROGRAM SBLAT1
*
-* -- Reference BLAS test routine (version 3.7.0) --
+* -- Reference BLAS test routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
REAL DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
+ DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
* .. External Subroutines ..
- EXTERNAL SROTG, SROTMG, STEST1
+ EXTERNAL SROTG, SROTMG, STEST, STEST1
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
-prefix=@prefix@
-libdir=@libdir@
+libdir=@CMAKE_INSTALL_FULL_LIBDIR@
+includedir=@CMAKE_INSTALL_FULL_INCLUDEDIR@
Name: BLAS
Description: FORTRAN reference implementation of BLAS Basic Linear Algebra Subprograms
Version: @LAPACK_VERSION@
URL: http://www.netlib.org/blas/
Libs: -L${libdir} -lblas
-Libs.private: -lm
endmacro()
append_subdir_files(CBLAS_INCLUDE "include")
-install(FILES ${CBLAS_INCLUDE} ${LAPACK_BINARY_DIR}/include/cblas_mangling.h DESTINATION include)
+install(FILES ${CBLAS_INCLUDE} ${LAPACK_BINARY_DIR}/include/cblas_mangling.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR})
# --------------------------------------------------
if(BUILD_TESTING)
set(_cblas_config_install_guard_target "")
if(ALL_TARGETS)
install(EXPORT cblas-targets
- DESTINATION ${LIBRARY_DIR}/cmake/cblas-${LAPACK_VERSION})
+ DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION})
# Choose one of the cblas targets to use as a guard for
# cblas-config.cmake to load targets from the install tree.
list(GET ALL_TARGETS 0 _cblas_config_install_guard_target)
install(FILES
${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/cblas-config.cmake
${LAPACK_BINARY_DIR}/cblas-config-version.cmake
- DESTINATION ${LIBRARY_DIR}/cmake/cblas-${LAPACK_VERSION}
+ DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION}
)
#install(EXPORT cblas-targets
-# DESTINATION ${LIBRARY_DIR}/cmake/cblas-${LAPACK_VERSION})
+# DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION})
include ../make.inc
-all:
- cd include && cp cblas_mangling_with_flags.h.in cblas_mangling.h
- cd src && $(MAKE) all
+all: cblas
+cblas: include/cblas_mangling.h
+ $(MAKE) -C src
-clean: cleanlib
+include/cblas_mangling.h: include/cblas_mangling_with_flags.h.in
+ cp $< $@
-cleanlib:
- cd src && $(MAKE) clean
-
-cleanexe:
- cd testing && $(MAKE) cleanexe
-
-cleanall: clean cleanexe
- rm -f $(CBLASLIB)
- cd examples && rm -f *.o cblas_ex1 cblas_ex2
+cblas_testing: cblas
+ $(MAKE) -C testing run
-cblas_testing:
- cd testing && $(MAKE) all
+cblas_example: cblas
+ $(MAKE) -C examples
-runtst:
- cd testing && $(MAKE) run
-
-example: all
- cd examples && $(MAKE) all
+clean:
+ $(MAKE) -C src clean
+ $(MAKE) -C testing clean
+ $(MAKE) -C examples clean
+cleanobj:
+ $(MAKE) -C src cleanobj
+ $(MAKE) -C testing cleanobj
+ $(MAKE) -C examples cleanobj
+cleanlib:
+ $(MAKE) -C src cleanlib
+cleanexe:
+ $(MAKE) -C testing cleanexe
+ $(MAKE) -C examples cleanexe
+cleantest:
+ $(MAKE) -C testing cleantest
-prefix=@prefix@
-libdir=@libdir@
+libdir=@CMAKE_INSTALL_FULL_LIBDIR@
+includedir=@CMAKE_INSTALL_FULL_INCLUDEDIR@
Name: CBLAS
Description: C Standard Interface to BLAS Basic Linear Algebra Subprograms
Version: @LAPACK_VERSION@
URL: http://www.netlib.org/blas/#_cblas
Libs: -L${libdir} -lcblas
-Requires: blas
+Cflags: -I${includedir}
+Requires.private: blas
get_filename_component(_CBLAS_PREFIX "${_CBLAS_PREFIX}" PATH)
# Load the LAPACK package with which we were built.
-set(LAPACK_DIR "${_CBLAS_PREFIX}/@{LIBRARY_DIR@/cmake/lapack-@LAPACK_VERSION@")
+set(LAPACK_DIR "${_CBLAS_PREFIX}/@CMAKE_INSTALL_LIBDIR@/cmake/lapack-@LAPACK_VERSION@")
find_package(LAPACK NO_MODULE)
# Load lapacke targets from the install tree.
add_executable(xexample1_CBLAS cblas_example1.c)
add_executable(xexample2_CBLAS cblas_example2.c)
-target_link_libraries(xexample1_CBLAS cblas ${BLAS_LIBRARIES})
+target_link_libraries(xexample1_CBLAS cblas)
target_link_libraries(xexample2_CBLAS cblas ${BLAS_LIBRARIES})
add_test(example1_CBLAS ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample1_CBLAS)
include ../../make.inc
-all: example1 example2
+all: cblas_ex1 cblas_ex2
-example1:
- $(CC) $(CFLAGS) -I../include -c cblas_example1.c
- $(LOADER) $(LOADOPTS) -o cblas_ex1 cblas_example1.o $(CBLASLIB) $(BLASLIB)
+cblas_ex1: cblas_example1.o $(CBLASLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+cblas_ex2: cblas_example2.o $(CBLASLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-example2:
- $(CC) $(CFLAGS) -I../include -c cblas_example2.c
- $(LOADER) $(LOADOPTS) -o cblas_ex2 cblas_example2.o $(CBLASLIB) $(BLASLIB)
+clean: cleanobj cleanexe
+cleanobj:
+ rm -f *.o
+cleanexe:
+ rm -f cblas_ex1 cblas_ex2
-cleanall:
- rm -f *.o cblas_ex1 cblas_ex2
+.c.o:
+ $(CC) $(CFLAGS) -I../include -c -o $@ $<
# This Makefile compiles the CBLAS routines
-#
-# Error handling routines for level 2 & 3
+# Error handling routines for level 2 & 3
set(ERRHAND cblas_globals.c cblas_xerbla.c xerbla.c)
#
#
#
-#
-# All object files for single real precision
-#
+# Files for level 1 single precision real
set(SLEV1 cblas_srotg.c cblas_srotmg.c cblas_srot.c cblas_srotm.c
cblas_sswap.c cblas_sscal.c cblas_scopy.c cblas_saxpy.c
cblas_sdot.c cblas_sdsdot.c cblas_snrm2.c cblas_sasum.c
cblas_isamax.c sdotsub.f sdsdotsub.f snrm2sub.f sasumsub.f
isamaxsub.f)
-#
-# All object files for double real precision
-#
+# Files for level 1 double precision real
set(DLEV1 cblas_drotg.c cblas_drotmg.c cblas_drot.c cblas_drotm.c
cblas_dswap.c cblas_dscal.c cblas_dcopy.c cblas_daxpy.c
cblas_ddot.c cblas_dsdot.c cblas_dnrm2.c cblas_dasum.c
cblas_idamax.c ddotsub.f dsdotsub.f dnrm2sub.f
dasumsub.f idamaxsub.f)
-#
-# All object files for single complex precision
-#
+# Files for level 1 single precision complex
set(CLEV1 cblas_cswap.c cblas_cscal.c cblas_csscal.c cblas_ccopy.c
cblas_caxpy.c cblas_cdotu_sub.c cblas_cdotc_sub.c
cblas_icamax.c cdotcsub.f cdotusub.f icamaxsub.f)
-#
-# All object files for double complex precision
-#
+# Files for level 1 double precision complex
set(ZLEV1 cblas_zswap.c cblas_zscal.c cblas_zdscal.c cblas_zcopy.c
cblas_zaxpy.c cblas_zdotu_sub.c cblas_zdotc_sub.c cblas_dznrm2.c
cblas_dzasum.c cblas_izamax.c zdotcsub.f zdotusub.f
dzasumsub.f dznrm2sub.f izamaxsub.f)
-#
-# Common files for single complex precision
-#
+# Common files for level 1 single precision
set(SCLEV1 cblas_scasum.c scasumsub.f cblas_scnrm2.c scnrm2sub.f)
#
-# All object files
-#
-set(ALEV1 ${slev1} ${dlev1} ${clev1} ${zlev1} ${sclev1})
-
-#
#
# CBLAS routines
#
#
#
-#
-# All object files for single real precision
-#
+# Files for level 2 single precision real
set(SLEV2 cblas_sgemv.c cblas_sgbmv.c cblas_sger.c cblas_ssbmv.c cblas_sspmv.c
cblas_sspr.c cblas_sspr2.c cblas_ssymv.c cblas_ssyr.c cblas_ssyr2.c
cblas_stbmv.c cblas_stbsv.c cblas_stpmv.c cblas_stpsv.c cblas_strmv.c
cblas_strsv.c)
-#
-# All object files for double real precision
-#
+# Files for level 2 double precision real
set(DLEV2 cblas_dgemv.c cblas_dgbmv.c cblas_dger.c cblas_dsbmv.c cblas_dspmv.c
cblas_dspr.c cblas_dspr2.c cblas_dsymv.c cblas_dsyr.c cblas_dsyr2.c
cblas_dtbmv.c cblas_dtbsv.c cblas_dtpmv.c cblas_dtpsv.c cblas_dtrmv.c
cblas_dtrsv.c)
-#
-# All object files for single complex precision
-#
+# Files for level 2 single precision complex
set(CLEV2 cblas_cgemv.c cblas_cgbmv.c cblas_chemv.c cblas_chbmv.c cblas_chpmv.c
cblas_ctrmv.c cblas_ctbmv.c cblas_ctpmv.c cblas_ctrsv.c cblas_ctbsv.c
cblas_ctpsv.c cblas_cgeru.c cblas_cgerc.c cblas_cher.c cblas_cher2.c
cblas_chpr.c cblas_chpr2.c)
-#
-# All object files for double complex precision
-#
+# Files for level 2 double precision complex
set(ZLEV2 cblas_zgemv.c cblas_zgbmv.c cblas_zhemv.c cblas_zhbmv.c cblas_zhpmv.c
cblas_ztrmv.c cblas_ztbmv.c cblas_ztpmv.c cblas_ztrsv.c cblas_ztbsv.c
cblas_ztpsv.c cblas_zgeru.c cblas_zgerc.c cblas_zher.c cblas_zher2.c
cblas_zhpr.c cblas_zhpr2.c)
#
-# All object files
-#
-set(AVEL2 ${slev2} ${dlev2} ${clev2} ${zlev2})
-
-#
#
# CBLAS routines
#
#
#
-#
-# All object files for single real precision
-#
+# Files for level 3 single precision real
set(SLEV3 cblas_sgemm.c cblas_ssymm.c cblas_ssyrk.c cblas_ssyr2k.c cblas_strmm.c
cblas_strsm.c)
-#
-# All object files for double real precision
-#
+# Files for level 3 double precision real
set(DLEV3 cblas_dgemm.c cblas_dsymm.c cblas_dsyrk.c cblas_dsyr2k.c cblas_dtrmm.c
cblas_dtrsm.c)
-#
-# All object files for single complex precision
-#
+# Files for level 3 single precision complex
set(CLEV3 cblas_cgemm.c cblas_csymm.c cblas_chemm.c cblas_cherk.c
cblas_cher2k.c cblas_ctrmm.c cblas_ctrsm.c cblas_csyrk.c
cblas_csyr2k.c)
-#
-# All object files for double complex precision
-#
+# Files for level 3 double precision complex
set(ZLEV3 cblas_zgemm.c cblas_zsymm.c cblas_zhemm.c cblas_zherk.c
cblas_zher2k.c cblas_ztrmm.c cblas_ztrsm.c cblas_zsyrk.c
cblas_zsyr2k.c)
-#
-# All object files
-#
-set(ALEV3 ${slev3} ${dlev3} ${clev3} ${zlev3})
-
-# default build all of it
-set(ALLOBJ ${SCLEV1} ${SLEV1} ${SLEV2} ${SLEV3} ${ERRHAND}
- ${DLEV1} ${DLEV2} ${DLEV3}
- ${CLEV1} ${CLEV2} ${CLEV3}
- ${ZLEV1} ${ZLEV2} ${ZLEV3})
-# Single real precision
-if(CBLAS_SINGLE)
- set(ALLOBJ ${SCLEV1} ${SLEV1} ${SLEV2} ${SLEV3} ${ERRHAND})
+set(SOURCES)
+if(BUILD_SINGLE)
+ list(APPEND SOURCES ${SLEV1} ${SCLEV1} ${SLEV2} ${SLEV3} ${ERRHAND})
endif()
-
-# Double real precision
-if(CBLAS_DOUBLE)
- set(ALLOBJ ${DLEV1} ${DLEV2} ${DLEV3} ${ERRHAND})
+if(BUILD_DOUBLE)
+ list(APPEND SOURCES ${DLEV1} ${DLEV2} ${DLEV3} ${ERRHAND})
endif()
-
-# Single complex precision
-if(CBLAS_COMPLEX)
- set(ALLOBJ ${CLEV1} ${SCLEV1} ${CLEV2} ${CLEV3} ${ERRHAND})
+if(BUILD_COMPLEX)
+ list(APPEND SOURCES ${CLEV1} ${SCLEV1} ${CLEV2} ${CLEV3} ${ERRHAND})
endif()
-
-# Double complex precision
-if(CBLAS_COMPLEX16)
- set(ALLOBJ ${ZLEV1} ${ZLEV2} ${ZLEV3} ${ERRHAND})
+if(BUILD_COMPLEX16)
+ list(APPEND SOURCES ${ZLEV1} ${ZLEV2} ${ZLEV3} ${ERRHAND})
endif()
-
-add_library(cblas ${ALLOBJ})
-target_link_libraries(cblas ${BLAS_LIBRARIES})
+list(REMOVE_DUPLICATES SOURCES)
+
+add_library(cblas ${SOURCES})
+set_target_properties(
+ cblas PROPERTIES
+ LINKER_LANGUAGE C
+ VERSION ${LAPACK_VERSION}
+ SOVERSION ${LAPACK_MAJOR_VERSION}
+ )
+target_include_directories(cblas PUBLIC
+ $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/../include>
+ $<INSTALL_INTERFACE:include>
+)
+target_link_libraries(cblas PRIVATE ${BLAS_LIBRARIES})
lapack_install_library(cblas)
# This Makefile compiles the CBLAS routines
-#
-include ../../make.inc
-#
-# Erase all object and archive files
-#
-all: cblaslib
+include ../../make.inc
-clean:
- rm -f *.o a.out core
+all: $(CBLASLIB)
# Error handling routines for level 2 & 3
-
errhand = cblas_globals.o cblas_xerbla.o xerbla.o
-# Object files of all routines
-alev = $(alev1) $(alev2) $(alev3) $(errhand)
-
#
#
# CBLAS routines
#
#
-#
-# All object files for single real precision
-#
+# Files for level 1 single precision real
slev1 = cblas_srotg.o cblas_srotmg.o cblas_srot.o cblas_srotm.o \
cblas_sswap.o cblas_sscal.o cblas_scopy.o cblas_saxpy.o \
cblas_sdot.o cblas_sdsdot.o cblas_snrm2.o cblas_sasum.o \
cblas_isamax.o sdotsub.o sdsdotsub.o snrm2sub.o sasumsub.o \
isamaxsub.o
-#
-# All object files for double real precision
-#
+# Files for level 1 double precision real
dlev1 = cblas_drotg.o cblas_drotmg.o cblas_drot.o cblas_drotm.o \
cblas_dswap.o cblas_dscal.o cblas_dcopy.o cblas_daxpy.o \
cblas_ddot.o cblas_dsdot.o cblas_dnrm2.o cblas_dasum.o \
cblas_idamax.o ddotsub.o dsdotsub.o dnrm2sub.o \
dasumsub.o idamaxsub.o
-#
-# All object files for single complex precision
-#
+# Files for level 1 single precision complex
clev1 = cblas_cswap.o cblas_cscal.o cblas_csscal.o cblas_ccopy.o \
cblas_caxpy.o cblas_cdotu_sub.o cblas_cdotc_sub.o \
cblas_icamax.o cdotcsub.o cdotusub.o icamaxsub.o
-#
-# All object files for double complex precision
-#
+# Files for level 1 double precision complex
zlev1 = cblas_zswap.o cblas_zscal.o cblas_zdscal.o cblas_zcopy.o \
cblas_zaxpy.o cblas_zdotu_sub.o cblas_zdotc_sub.o cblas_dznrm2.o \
cblas_dzasum.o cblas_izamax.o zdotcsub.o zdotusub.o \
dzasumsub.o dznrm2sub.o izamaxsub.o
-#
-# Common files for single / complex precision
-#
+# Common files for level 1 single precision
sclev1 = cblas_scasum.o scasumsub.o cblas_scnrm2.o scnrm2sub.o
-#
-# All object files
-#
-alev1 = $(slev1) $(dlev1) $(clev1) $(zlev1) $(sclev1)
-
-#
-# Make an archive file
-#
-
-# Single real precision
+# Single precision real
slib1: $(slev1) $(sclev1)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(slev1) $(sclev1)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# Double real precision
+# Double precision real
dlib1: $(dlev1)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(dlev1)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# Single complex precision
+# Single precision complex
clib1: $(clev1) $(sclev1)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(clev1) $(sclev1)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# Double complex precision
+# Double precision complex
zlib1: $(zlev1)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(zlev1)
- $(RANLIB) $(CBLASLIB)
-
-# All precisions
-all1: $(alev1)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(alev1)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
#
#
#
-#
-# All object files for single real precision
-#
+# Files for level 2 single precision real
slev2 = cblas_sgemv.o cblas_sgbmv.o cblas_sger.o cblas_ssbmv.o cblas_sspmv.o \
cblas_sspr.o cblas_sspr2.o cblas_ssymv.o cblas_ssyr.o cblas_ssyr2.o \
cblas_stbmv.o cblas_stbsv.o cblas_stpmv.o cblas_stpsv.o cblas_strmv.o \
cblas_strsv.o
-#
-# All object files for double real precision
-#
+# Files for level 2 double precision real
dlev2 = cblas_dgemv.o cblas_dgbmv.o cblas_dger.o cblas_dsbmv.o cblas_dspmv.o \
cblas_dspr.o cblas_dspr2.o cblas_dsymv.o cblas_dsyr.o cblas_dsyr2.o \
cblas_dtbmv.o cblas_dtbsv.o cblas_dtpmv.o cblas_dtpsv.o cblas_dtrmv.o \
cblas_dtrsv.o
-#
-# All object files for single complex precision
-#
+# Files for level 2 single precision complex
clev2 = cblas_cgemv.o cblas_cgbmv.o cblas_chemv.o cblas_chbmv.o cblas_chpmv.o \
cblas_ctrmv.o cblas_ctbmv.o cblas_ctpmv.o cblas_ctrsv.o cblas_ctbsv.o \
cblas_ctpsv.o cblas_cgeru.o cblas_cgerc.o cblas_cher.o cblas_cher2.o \
cblas_chpr.o cblas_chpr2.o
-#
-# All object files for double complex precision
-#
+# Files for level 2 double precision complex
zlev2 = cblas_zgemv.o cblas_zgbmv.o cblas_zhemv.o cblas_zhbmv.o cblas_zhpmv.o \
cblas_ztrmv.o cblas_ztbmv.o cblas_ztpmv.o cblas_ztrsv.o cblas_ztbsv.o \
cblas_ztpsv.o cblas_zgeru.o cblas_zgerc.o cblas_zher.o cblas_zher2.o \
cblas_zhpr.o cblas_zhpr2.o
-#
-# All object files
-#
-alev2 = $(slev2) $(dlev2) $(clev2) $(zlev2)
-
-#
-# Make an archive file
-#
-
-# Single real precision
+# Single precision real
slib2: $(slev2) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(slev2) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# Double real precision
+# Double precision real
dlib2: $(dlev2) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(dlev2) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# Single complex precision
+# Single precision complex
clib2: $(clev2) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(clev2) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# Double complex precision
+# Double precision complex
zlib2: $(zlev2) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(zlev2) $(errhand)
- $(RANLIB) $(CBLASLIB)
-
-# All precisions
-all2: $(alev2) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(alev2) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
#
#
#
-#
-# All object files for single real precision
-#
+# Files for level 3 single precision real
slev3 = cblas_sgemm.o cblas_ssymm.o cblas_ssyrk.o cblas_ssyr2k.o cblas_strmm.o \
cblas_strsm.o
-#
-# All object files for double real precision
-#
+# Files for level 3 double precision real
dlev3 = cblas_dgemm.o cblas_dsymm.o cblas_dsyrk.o cblas_dsyr2k.o cblas_dtrmm.o \
cblas_dtrsm.o
-#
-# All object files for single complex precision
-#
+# Files for level 3 single precision complex
clev3 = cblas_cgemm.o cblas_csymm.o cblas_chemm.o cblas_cherk.o \
cblas_cher2k.o cblas_ctrmm.o cblas_ctrsm.o cblas_csyrk.o \
cblas_csyr2k.o
-#
-# All object files for double complex precision
-#
+# Files for level 3 double precision complex
zlev3 = cblas_zgemm.o cblas_zsymm.o cblas_zhemm.o cblas_zherk.o \
cblas_zher2k.o cblas_ztrmm.o cblas_ztrsm.o cblas_zsyrk.o \
cblas_zsyr2k.o
-#
-# All object files
-#
-alev3 = $(slev3) $(dlev3) $(clev3) $(zlev3)
-
-#
-# Make an archive file
-#
-
-# Single real precision
+# Single precision real
slib3: $(slev3) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(slev3) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# Double real precision
+# Double precision real
dlib3: $(dlev3) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(dlev3) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# Single complex precision
+# Single precision complex
clib3: $(clev3) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(clev3) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# Single complex precision
+# Double precision complex
zlib3: $(zlev3) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(zlev3) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
+ $(RANLIB) $(CBLASLIB)
+
+
+alev1 = $(slev1) $(dlev1) $(clev1) $(zlev1) $(sclev1)
+alev2 = $(slev2) $(dlev2) $(clev2) $(zlev2)
+alev3 = $(slev3) $(dlev3) $(clev3) $(zlev3)
+
+# All level 1
+all1: $(alev1)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
-# All precisions
+# All level 2
+all2: $(alev2) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
+ $(RANLIB) $(CBLASLIB)
+
+# All level 3
all3: $(alev3) $(errhand)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(alev3)
+ $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^
$(RANLIB) $(CBLASLIB)
# All levels and precisions
-cblaslib: $(alev)
- $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $(alev)
- $(RANLIB) $(CBLASLIB)
+$(CBLASLIB): $(alev1) $(alev2) $(alev3) $(errhand)
+ $(ARCH) $(ARCHFLAGS) $@ $^
+ $(RANLIB) $@
FRC:
@FRC=$(FRC)
+clean: cleanobj cleanlib
+cleanobj:
+ rm -f *.o
+cleanlib:
+ rm -f $(CBLASLIB)
+
.c.o:
$(CC) $(CFLAGS) -I../include -c -o $@ $<
-
.f.o:
$(FORTRAN) $(OPTS) -c -o $@ $<
endmacro()
-# Object files for single real precision
+# Object files for single precision real
set(STESTL1O c_sblas1.c)
set(STESTL2O c_sblas2.c c_s2chke.c auxiliary.c c_xerbla.c)
set(STESTL3O c_sblas3.c c_s3chke.c auxiliary.c c_xerbla.c)
-# Object files for double real precision
+# Object files for double precision real
set(DTESTL1O c_dblas1.c)
set(DTESTL2O c_dblas2.c c_d2chke.c auxiliary.c c_xerbla.c)
set(DTESTL3O c_dblas3.c c_d3chke.c auxiliary.c c_xerbla.c)
-# Object files for single complex precision
+# Object files for single precision complex
set(CTESTL1O c_cblat1.f c_cblas1.c)
set(CTESTL2O c_cblas2.c c_c2chke.c auxiliary.c c_xerbla.c)
set(CTESTL3O c_cblas3.c c_c3chke.c auxiliary.c c_xerbla.c)
-# Object files for double complex precision
+# Object files for double precision complex
set(ZTESTL1O c_zblas1.c)
set(ZTESTL2O c_zblas2.c c_z2chke.c auxiliary.c c_xerbla.c)
set(ZTESTL3O c_zblas3.c c_z3chke.c auxiliary.c c_xerbla.c)
add_executable(xscblat2 c_sblat2.f ${STESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
add_executable(xscblat3 c_sblat3.f ${STESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
- target_link_libraries(xscblat1 cblas ${BLAS_LIBRARIES})
- target_link_libraries(xscblat2 cblas ${BLAS_LIBRARIES})
- target_link_libraries(xscblat3 cblas ${BLAS_LIBRARIES})
+ target_link_libraries(xscblat1 cblas)
+ target_link_libraries(xscblat2 cblas)
+ target_link_libraries(xscblat3 cblas)
add_cblas_test(stest1.out "" xscblat1)
add_cblas_test(stest2.out sin2 xscblat2)
add_executable(xdcblat2 c_dblat2.f ${DTESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
add_executable(xdcblat3 c_dblat3.f ${DTESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
- target_link_libraries(xdcblat1 cblas ${BLAS_LIBRARIES})
- target_link_libraries(xdcblat2 cblas ${BLAS_LIBRARIES})
- target_link_libraries(xdcblat3 cblas ${BLAS_LIBRARIES})
+ target_link_libraries(xdcblat1 cblas)
+ target_link_libraries(xdcblat2 cblas)
+ target_link_libraries(xdcblat3 cblas)
add_cblas_test(dtest1.out "" xdcblat1)
add_cblas_test(dtest2.out din2 xdcblat2)
add_executable(xccblat3 c_cblat3.f ${CTESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
target_link_libraries(xccblat1 cblas ${BLAS_LIBRARIES})
- target_link_libraries(xccblat2 cblas ${BLAS_LIBRARIES})
- target_link_libraries(xccblat3 cblas ${BLAS_LIBRARIES})
+ target_link_libraries(xccblat2 cblas)
+ target_link_libraries(xccblat3 cblas)
add_cblas_test(ctest1.out "" xccblat1)
add_cblas_test(ctest2.out cin2 xccblat2)
add_executable(xzcblat2 c_zblat2.f ${ZTESTL2O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
add_executable(xzcblat3 c_zblat3.f ${ZTESTL3O} ${LAPACK_BINARY_DIR}/include/cblas_test.h)
- target_link_libraries(xzcblat1 cblas ${BLAS_LIBRARIES})
- target_link_libraries(xzcblat2 cblas ${BLAS_LIBRARIES})
- target_link_libraries(xzcblat3 cblas ${BLAS_LIBRARIES})
+ target_link_libraries(xzcblat1 cblas)
+ target_link_libraries(xzcblat2 cblas)
+ target_link_libraries(xzcblat3 cblas)
add_cblas_test(ztest1.out "" xzcblat1)
add_cblas_test(ztest2.out zin2 xzcblat2)
# Archive files necessary to compile
LIB = $(CBLASLIB) $(BLASLIB)
-# Object files for single real precision
+# Object files for single precision real
stestl1o = c_sblas1.o
stestl2o = c_sblas2.o c_s2chke.o auxiliary.o c_xerbla.o
stestl3o = c_sblas3.o c_s3chke.o auxiliary.o c_xerbla.o
-# Object files for double real precision
+# Object files for double precision real
dtestl1o = c_dblas1.o
dtestl2o = c_dblas2.o c_d2chke.o auxiliary.o c_xerbla.o
dtestl3o = c_dblas3.o c_d3chke.o auxiliary.o c_xerbla.o
-# Object files for single complex precision
+# Object files for single precision complex
ctestl1o = c_cblas1.o
ctestl2o = c_cblas2.o c_c2chke.o auxiliary.o c_xerbla.o
ctestl3o = c_cblas3.o c_c3chke.o auxiliary.o c_xerbla.o
-# Object files for double complex precision
+# Object files for double precision complex
ztestl1o = c_zblas1.o
ztestl2o = c_zblas2.o c_z2chke.o auxiliary.o c_xerbla.o
ztestl3o = c_zblas3.o c_z3chke.o auxiliary.o c_xerbla.o
all: all1 all2 all3
-all1: stest1 dtest1 ctest1 ztest1
-all2: stest2 dtest2 ctest2 ztest2
-all3: stest3 dtest3 ctest3 ztest3
-
-clean:
- rm -f core *.o *.out x*
-cleanobj:
- rm -f core *.o a.out
-cleanexe:
- rm -f x*
-
-stest1: xscblat1
-dtest1: xdcblat1
-ctest1: xccblat1
-ztest1: xzcblat1
-
-stest2: xscblat2
-dtest2: xdcblat2
-ctest2: xccblat2
-ztest2: xzcblat2
-
-stest3: xscblat3
-dtest3: xdcblat3
-ctest3: xccblat3
-ztest3: xzcblat3
+all1: xscblat1 xdcblat1 xccblat1 xzcblat1
+all2: xscblat2 xdcblat2 xccblat2 xzcblat2
+all3: xscblat3 xdcblat3 xccblat3 xzcblat3
#
# Compile each precision
#
# Single real
-xscblat1: $(stestl1o) c_sblat1.o
- $(LOADER) $(LOADOPTS) -o $@ c_sblat1.o $(stestl1o) $(LIB)
-xscblat2: $(stestl2o) c_sblat2.o
- $(LOADER) $(LOADOPTS) -o $@ c_sblat2.o $(stestl2o) $(LIB)
-xscblat3: $(stestl3o) c_sblat3.o
- $(LOADER) $(LOADOPTS) -o $@ c_sblat3.o $(stestl3o) $(LIB)
+xscblat1: c_sblat1.o $(stestl1o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xscblat2: c_sblat2.o $(stestl2o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xscblat3: c_sblat3.o $(stestl3o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
# Double real
-xdcblat1: $(dtestl1o) c_dblat1.o
- $(LOADER) $(LOADOPTS) -o $@ c_dblat1.o $(dtestl1o) $(LIB)
-xdcblat2: $(dtestl2o) c_dblat2.o
- $(LOADER) $(LOADOPTS) -o $@ c_dblat2.o $(dtestl2o) $(LIB)
-xdcblat3: $(dtestl3o) c_dblat3.o
- $(LOADER) $(LOADOPTS) -o $@ c_dblat3.o $(dtestl3o) $(LIB)
+xdcblat1: c_dblat1.o $(dtestl1o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xdcblat2: c_dblat2.o $(dtestl2o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xdcblat3: c_dblat3.o $(dtestl3o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
# Single complex
-xccblat1: $(ctestl1o) c_cblat1.o
- $(LOADER) $(LOADOPTS) -o $@ c_cblat1.o $(ctestl1o) $(LIB)
-xccblat2: $(ctestl2o) c_cblat2.o
- $(LOADER) $(LOADOPTS) -o $@ c_cblat2.o $(ctestl2o) $(LIB)
-xccblat3: $(ctestl3o) c_cblat3.o
- $(LOADER) $(LOADOPTS) -o $@ c_cblat3.o $(ctestl3o) $(LIB)
+xccblat1: c_cblat1.o $(ctestl1o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xccblat2: c_cblat2.o $(ctestl2o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xccblat3: c_cblat3.o $(ctestl3o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
# Double complex
-xzcblat1: $(ztestl1o) c_zblat1.o
- $(LOADER) $(LOADOPTS) -o $@ c_zblat1.o $(ztestl1o) $(LIB)
-xzcblat2: $(ztestl2o) c_zblat2.o
- $(LOADER) $(LOADOPTS) -o $@ c_zblat2.o $(ztestl2o) $(LIB)
-xzcblat3: $(ztestl3o) c_zblat3.o
- $(LOADER) $(LOADOPTS) -o $@ c_zblat3.o $(ztestl3o) $(LIB)
+xzcblat1: c_zblat1.o $(ztestl1o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xzcblat2: c_zblat2.o $(ztestl2o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
+xzcblat3: c_zblat3.o $(ztestl3o) $(LIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
# RUN TESTS
-run:
- @echo "--> TESTING CBLAS 1 - SINGLE PRECISION <--"
+run: all
+ @echo "--> TESTING CBLAS 1 - SINGLE PRECISION REAL <--"
@./xscblat1 > stest1.out
- @echo "--> TESTING CBLAS 1 - DOUBLE PRECISION <--"
+ @echo "--> TESTING CBLAS 1 - DOUBLE PRECISION REAL <--"
@./xdcblat1 > dtest1.out
- @echo "--> TESTING CBLAS 1 - COMPLEX PRECISION <--"
+ @echo "--> TESTING CBLAS 1 - SINGLE PRECISION COMPLEX <--"
@./xccblat1 > ctest1.out
- @echo "--> TESTING CBLAS 1 - DOUBLE COMPLEX PRECISION <--"
+ @echo "--> TESTING CBLAS 1 - DOUBLE PRECISION COMPLEX <--"
@./xzcblat1 > ztest1.out
- @echo "--> TESTING CBLAS 2 - SINGLE PRECISION <--"
+ @echo "--> TESTING CBLAS 2 - SINGLE PRECISION REAL <--"
@./xscblat2 < sin2 > stest2.out
- @echo "--> TESTING CBLAS 2 - DOUBLE PRECISION <--"
+ @echo "--> TESTING CBLAS 2 - DOUBLE PRECISION REAL <--"
@./xdcblat2 < din2 > dtest2.out
- @echo "--> TESTING CBLAS 2 - COMPLEX PRECISION <--"
+ @echo "--> TESTING CBLAS 2 - SINGLE PRECISION COMPLEX <--"
@./xccblat2 < cin2 > ctest2.out
- @echo "--> TESTING CBLAS 2 - DOUBLE COMPLEX PRECISION <--"
+ @echo "--> TESTING CBLAS 2 - DOUBLE PRECISION COMPLEX <--"
@./xzcblat2 < zin2 > ztest2.out
- @echo "--> TESTING CBLAS 3 - SINGLE PRECISION <--"
+ @echo "--> TESTING CBLAS 3 - SINGLE PRECISION REAL <--"
@./xscblat3 < sin3 > stest3.out
- @echo "--> TESTING CBLAS 3 - DOUBLE PRECISION <--"
+ @echo "--> TESTING CBLAS 3 - DOUBLE PRECISION REAL <--"
@./xdcblat3 < din3 > dtest3.out
- @echo "--> TESTING CBLAS 3 - COMPLEX PRECISION <--"
+ @echo "--> TESTING CBLAS 3 - SINGLE PRECISION COMPLEX <--"
@./xccblat3 < cin3 > ctest3.out
- @echo "--> TESTING CBLAS 3 - DOUBLE COMPLEX PRECISION <--"
+ @echo "--> TESTING CBLAS 3 - DOUBLE PRECISION COMPLEX <--"
@./xzcblat3 < zin3 > ztest3.out
-.SUFFIXES: .o .f .c
+clean: cleanobj cleanexe cleantest
+cleanobj:
+ rm -f *.o
+cleanexe:
+ rm -f x*
+cleantest:
+ rm -f *.out core
+.SUFFIXES: .o .f .c
.c.o:
$(CC) $(CFLAGS) -I../include -c -o $@ $<
-
.f.o:
$(FORTRAN) $(OPTS) -c -o $@ $<
--- /dev/null
+# This file is part of CMake-codecov.
+#
+# https://github.com/RWTH-ELP/CMake-codecov
+#
+# Copyright (c)
+# 2015-2016 RWTH Aachen University, Federal Republic of Germany
+#
+# LICENSE : BSD 3-Clause License
+#
+# Written by Alexander Haase, alexander.haase@rwth-aachen.de
+# Updated by Guillaume Jacquenot, guillaume.jacquenot@gmail.com
+
+# include required Modules
+include(FindPackageHandleStandardArgs)
+
+
+# Search for gcov binary.
+set(CMAKE_REQUIRED_QUIET_SAVE ${CMAKE_REQUIRED_QUIET})
+set(CMAKE_REQUIRED_QUIET ${codecov_FIND_QUIETLY})
+
+get_property(ENABLED_LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES)
+foreach (LANG ${ENABLED_LANGUAGES})
+ # Gcov evaluation is dependend on the used compiler. Check gcov support for
+ # each compiler that is used. If gcov binary was already found for this
+ # compiler, do not try to find it again.
+ if(NOT GCOV_${CMAKE_${LANG}_COMPILER_ID}_BIN)
+ get_filename_component(COMPILER_PATH "${CMAKE_${LANG}_COMPILER}" PATH)
+
+ if("${CMAKE_${LANG}_COMPILER_ID}" STREQUAL "GNU")
+ # Some distributions like OSX (homebrew) ship gcov with the compiler
+ # version appended as gcov-x. To find this binary we'll build the
+ # suggested binary name with the compiler version.
+ string(REGEX MATCH "^[0-9]+" GCC_VERSION
+ "${CMAKE_${LANG}_COMPILER_VERSION}")
+
+ find_program(GCOV_BIN NAMES gcov-${GCC_VERSION} gcov
+ HINTS ${COMPILER_PATH})
+
+ elseif("${CMAKE_${LANG}_COMPILER_ID}" STREQUAL "Clang")
+ # Some distributions like Debian ship llvm-cov with the compiler
+ # version appended as llvm-cov-x.y. To find this binary we'll build
+ # the suggested binary name with the compiler version.
+ string(REGEX MATCH "^[0-9]+.[0-9]+" LLVM_VERSION
+ "${CMAKE_${LANG}_COMPILER_VERSION}")
+
+ # llvm-cov prior version 3.5 seems to be not working with coverage
+ # evaluation tools, but these versions are compatible with the gcc
+ # gcov tool.
+ if(LLVM_VERSION VERSION_GREATER 3.4)
+ find_program(LLVM_COV_BIN NAMES "llvm-cov-${LLVM_VERSION}"
+ "llvm-cov" HINTS ${COMPILER_PATH})
+ mark_as_advanced(LLVM_COV_BIN)
+
+ if(LLVM_COV_BIN)
+ find_program(LLVM_COV_WRAPPER "llvm-cov-wrapper" PATHS
+ ${CMAKE_MODULE_PATH})
+ if(LLVM_COV_WRAPPER)
+ set(GCOV_BIN "${LLVM_COV_WRAPPER}" CACHE FILEPATH "")
+
+ # set additional parameters
+ set(GCOV_${CMAKE_${LANG}_COMPILER_ID}_ENV
+ "LLVM_COV_BIN=${LLVM_COV_BIN}" CACHE STRING
+ "Environment variables for llvm-cov-wrapper.")
+ mark_as_advanced(GCOV_${CMAKE_${LANG}_COMPILER_ID}_ENV)
+ endif()
+ endif()
+ endif()
+
+ if(NOT GCOV_BIN)
+ # Fall back to gcov binary if llvm-cov was not found or is
+ # incompatible. This is the default on OSX, but may crash on
+ # recent Linux versions.
+ find_program(GCOV_BIN gcov HINTS ${COMPILER_PATH})
+ endif()
+ endif()
+
+
+ if(GCOV_BIN)
+ set(GCOV_${CMAKE_${LANG}_COMPILER_ID}_BIN "${GCOV_BIN}" CACHE STRING
+ "${LANG} gcov binary.")
+
+ if(NOT CMAKE_REQUIRED_QUIET)
+ message("-- Found gcov evaluation for "
+ "${CMAKE_${LANG}_COMPILER_ID}: ${GCOV_BIN}")
+ endif()
+
+ unset(GCOV_BIN CACHE)
+ endif()
+ endif()
+endforeach ()
+
+
+# Add a new global target for all gcov targets. This target could be used to
+# generate the gcov files for the whole project instead of calling <TARGET>-gcov
+# for each target.
+if(NOT TARGET coverage)
+ add_custom_target(coverage)
+endif()
+
+
+# This function will add gcov evaluation for target <TNAME>. Only sources of
+# this target will be evaluated and no dependencies will be added. It will call
+# Gcov on any source file of <TNAME> once and store the gcov file in the same
+# directory.
+function (add_gcov_target TNAME)
+ set(TDIR ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${TNAME}.dir)
+
+ # We don't have to check, if the target has support for coverage, thus this
+ # will be checked by add_coverage_target in Findcoverage.cmake. Instead we
+ # have to determine which gcov binary to use.
+ get_target_property(TSOURCES ${TNAME} SOURCES)
+ set(SOURCES "")
+ set(TCOMPILER "")
+ foreach (FILE ${TSOURCES})
+ codecov_path_of_source(${FILE} FILE)
+ if(NOT "${FILE}" STREQUAL "")
+ codecov_lang_of_source(${FILE} LANG)
+ if(NOT "${LANG}" STREQUAL "")
+ list(APPEND SOURCES "${FILE}")
+ set(TCOMPILER ${CMAKE_${LANG}_COMPILER_ID})
+ endif()
+ endif()
+ endforeach()
+
+ # If no gcov binary was found, coverage data can't be evaluated.
+ if(NOT GCOV_${TCOMPILER}_BIN)
+ message(WARNING "No coverage evaluation binary found for ${TCOMPILER}.")
+ return()
+ endif()
+
+ set(GCOV_BIN "${GCOV_${TCOMPILER}_BIN}")
+ set(GCOV_ENV "${GCOV_${TCOMPILER}_ENV}")
+
+
+ set(BUFFER "")
+ foreach(FILE ${SOURCES})
+ get_filename_component(FILE_PATH "${TDIR}/${FILE}" PATH)
+
+ # call gcov
+ add_custom_command(OUTPUT ${TDIR}/${FILE}.gcov
+ COMMAND ${GCOV_ENV} ${GCOV_BIN} ${TDIR}/${FILE}.gcno > /dev/null
+ DEPENDS ${TNAME} ${TDIR}/${FILE}.gcno
+ WORKING_DIRECTORY ${FILE_PATH}
+ )
+
+ list(APPEND BUFFER ${TDIR}/${FILE}.gcov)
+ endforeach()
+
+
+ # add target for gcov evaluation of <TNAME>
+ add_custom_target(${TNAME}-gcov DEPENDS ${BUFFER})
+
+ # add evaluation target to the global gcov target.
+ add_dependencies(coverage ${TNAME}-gcov)
+endfunction()
--- /dev/null
+# This file is part of CMake-codecov.
+#
+# https://github.com/RWTH-ELP/CMake-codecov
+#
+# Copyright (c)
+# 2015-2016 RWTH Aachen University, Federal Republic of Germany
+#
+# LICENSE : BSD 3-Clause License
+#
+# Written by Alexander Haase, alexander.haase@rwth-aachen.de
+# Updated by Guillaume Jacquenot, guillaume.jacquenot@gmail.com
+
+set(COVERAGE_FLAG_CANDIDATES
+ # gcc and clang
+ "-O0 -g -fprofile-arcs -ftest-coverage"
+
+ # gcc and clang fallback
+ "-O0 -g --coverage"
+)
+
+
+# To avoid error messages about CMP0051, this policy will be set to new. There
+# will be no problem, as TARGET_OBJECTS generator expressions will be filtered
+# with a regular expression from the sources.
+if(POLICY CMP0051)
+ cmake_policy(SET CMP0051 NEW)
+endif()
+
+
+# Add coverage support for target ${TNAME} and register target for coverage
+# evaluation.
+function(add_coverage TNAME)
+ foreach (TNAME ${ARGV})
+ add_coverage_target(${TNAME})
+ endforeach()
+endfunction()
+
+
+# Find the reuired flags foreach language.
+set(CMAKE_REQUIRED_QUIET_SAVE ${CMAKE_REQUIRED_QUIET})
+set(CMAKE_REQUIRED_QUIET ${codecov_FIND_QUIETLY})
+
+get_property(ENABLED_LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES)
+foreach (LANG ${ENABLED_LANGUAGES})
+ # Coverage flags are not dependend on language, but the used compiler. So
+ # instead of searching flags foreach language, search flags foreach compiler
+ # used.
+ set(COMPILER ${CMAKE_${LANG}_COMPILER_ID})
+ if(NOT COVERAGE_${COMPILER}_FLAGS)
+ foreach (FLAG ${COVERAGE_FLAG_CANDIDATES})
+ if(NOT CMAKE_REQUIRED_QUIET)
+ message(STATUS "Try ${COMPILER} code coverage flag = [${FLAG}]")
+ endif()
+
+ set(CMAKE_REQUIRED_FLAGS "${FLAG}")
+ unset(COVERAGE_FLAG_DETECTED CACHE)
+
+ if(${LANG} STREQUAL "C")
+ include(CheckCCompilerFlag)
+ check_c_compiler_flag("${FLAG}" COVERAGE_FLAG_DETECTED)
+
+ elseif(${LANG} STREQUAL "CXX")
+ include(CheckCXXCompilerFlag)
+ check_cxx_compiler_flag("${FLAG}" COVERAGE_FLAG_DETECTED)
+
+ elseif(${LANG} STREQUAL "Fortran")
+ # CheckFortranCompilerFlag was introduced in CMake 3.x. To be
+ # compatible with older Cmake versions, we will check if this
+ # module is present before we use it. Otherwise we will define
+ # Fortran coverage support as not available.
+ include(CheckFortranCompilerFlag OPTIONAL
+ RESULT_VARIABLE INCLUDED)
+ if(INCLUDED)
+ check_fortran_compiler_flag("${FLAG}"
+ COVERAGE_FLAG_DETECTED)
+ elseif(NOT CMAKE_REQUIRED_QUIET)
+ message("-- Performing Test COVERAGE_FLAG_DETECTED")
+ message("-- Performing Test COVERAGE_FLAG_DETECTED - Failed"
+ " (Check not supported)")
+ endif()
+ endif()
+
+ if(COVERAGE_FLAG_DETECTED)
+ set(COVERAGE_${COMPILER}_FLAGS "${FLAG}"
+ CACHE STRING "${COMPILER} flags for code coverage.")
+ mark_as_advanced(COVERAGE_${COMPILER}_FLAGS)
+ break()
+ endif()
+ endforeach()
+ endif()
+endforeach()
+
+set(CMAKE_REQUIRED_QUIET ${CMAKE_REQUIRED_QUIET_SAVE})
+
+# Helper function to get the language of a source file.
+function (codecov_lang_of_source FILE RETURN_VAR)
+ get_filename_component(FILE_EXT "${FILE}" EXT)
+ string(TOLOWER "${FILE_EXT}" FILE_EXT)
+ string(SUBSTRING "${FILE_EXT}" 1 -1 FILE_EXT)
+
+ get_property(ENABLED_LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES)
+ foreach (LANG ${ENABLED_LANGUAGES})
+ list(FIND CMAKE_${LANG}_SOURCE_FILE_EXTENSIONS "${FILE_EXT}" TEMP)
+ if(NOT ${TEMP} EQUAL -1)
+ set(${RETURN_VAR} "${LANG}" PARENT_SCOPE)
+ return()
+ endif()
+ endforeach()
+
+ set(${RETURN_VAR} "" PARENT_SCOPE)
+endfunction()
+
+# Helper function to get the relative path of the source file destination path.
+# This path is needed by FindGcov and FindLcov cmake files to locate the
+# captured data.
+function (codecov_path_of_source FILE RETURN_VAR)
+ string(REGEX MATCH "TARGET_OBJECTS:([^ >]+)" _source ${FILE})
+
+ # If expression was found, SOURCEFILE is a generator-expression for an
+ # object library. Currently we found no way to call this function automatic
+ # for the referenced target, so it must be called in the directoryso of the
+ # object library definition.
+ if(NOT "${_source}" STREQUAL "")
+ set(${RETURN_VAR} "" PARENT_SCOPE)
+ return()
+ endif()
+
+ string(REPLACE "${CMAKE_CURRENT_BINARY_DIR}/" "" FILE "${FILE}")
+ if(IS_ABSOLUTE ${FILE})
+ file(RELATIVE_PATH FILE ${CMAKE_CURRENT_SOURCE_DIR} ${FILE})
+ endif()
+
+ # get the right path for file
+ string(REPLACE ".." "__" PATH "${FILE}")
+
+ set(${RETURN_VAR} "${PATH}" PARENT_SCOPE)
+endfunction()
+
+# Add coverage support for target ${TNAME} and register target for coverage
+# evaluation.
+function(add_coverage_target TNAME)
+ # Check if all sources for target use the same compiler. If a target uses
+ # e.g. C and Fortran mixed and uses different compilers (e.g. clang and
+ # gfortran) this can trigger huge problems, because different compilers may
+ # use different implementations for code coverage.
+ get_target_property(TSOURCES ${TNAME} SOURCES)
+ set(TARGET_COMPILER "")
+ set(ADDITIONAL_FILES "")
+ foreach (FILE ${TSOURCES})
+ # If expression was found, FILE is a generator-expression for an object
+ # library. Object libraries will be ignored.
+ string(REGEX MATCH "TARGET_OBJECTS:([^ >]+)" _file ${FILE})
+ if("${_file}" STREQUAL "")
+ codecov_lang_of_source(${FILE} LANG)
+ if(LANG)
+ list(APPEND TARGET_COMPILER ${CMAKE_${LANG}_COMPILER_ID})
+
+ list(APPEND ADDITIONAL_FILES "${FILE}.gcno")
+ list(APPEND ADDITIONAL_FILES "${FILE}.gcda")
+ endif()
+ endif()
+ endforeach ()
+
+ list(REMOVE_DUPLICATES TARGET_COMPILER)
+ list(LENGTH TARGET_COMPILER NUM_COMPILERS)
+
+ if(NUM_COMPILERS GREATER 1)
+ message(AUTHOR_WARNING "Coverage disabled for target ${TNAME} because "
+ "it will be compiled by different compilers.")
+ return()
+
+ elseif((NUM_COMPILERS EQUAL 0) OR
+ (NOT DEFINED "COVERAGE_${TARGET_COMPILER}_FLAGS"))
+ message(AUTHOR_WARNING "Coverage disabled for target ${TNAME} "
+ "because there is no sanitizer available for target sources.")
+ return()
+ endif()
+
+
+ # enable coverage for target
+ set_property(TARGET ${TNAME} APPEND_STRING
+ PROPERTY COMPILE_FLAGS " ${COVERAGE_${TARGET_COMPILER}_FLAGS}")
+ set_property(TARGET ${TNAME} APPEND_STRING
+ PROPERTY LINK_FLAGS " ${COVERAGE_${TARGET_COMPILER}_FLAGS}")
+
+
+ # Add gcov files generated by compiler to clean target.
+ set(CLEAN_FILES "")
+ foreach (FILE ${ADDITIONAL_FILES})
+ codecov_path_of_source(${FILE} FILE)
+ list(APPEND CLEAN_FILES "CMakeFiles/${TNAME}.dir/${FILE}")
+ endforeach()
+
+ set_directory_properties(PROPERTIES ADDITIONAL_MAKE_CLEAN_FILES
+ "${CLEAN_FILES}")
+
+ add_gcov_target(${TNAME})
+endfunction()
+
+# Include modules for parsing the collected data and output it in a readable
+# format (like gcov).
+find_package(Gcov)
-cmake_minimum_required(VERSION 2.8.10)
+cmake_minimum_required(VERSION 2.8.12)
+
+project(LAPACK Fortran C)
+
+set(LAPACK_MAJOR_VERSION 3)
+set(LAPACK_MINOR_VERSION 8)
+set(LAPACK_PATCH_VERSION 0)
+set(
+ LAPACK_VERSION
+ ${LAPACK_MAJOR_VERSION}.${LAPACK_MINOR_VERSION}.${LAPACK_PATCH_VERSION}
+ )
+
+# Add the CMake directory for custon CMake modules
+set(CMAKE_MODULE_PATH "${LAPACK_SOURCE_DIR}/CMAKE" ${CMAKE_MODULE_PATH})
# Set a default build type if none was specified
if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES)
message(STATUS "Setting build type to 'Release' as none was specified.")
set(CMAKE_BUILD_TYPE Release CACHE STRING "Choose the type of build." FORCE)
# Set the possible values of build type for cmake-gui
- set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release" "MinSizeRel" "RelWithDebInfo")
+ set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release" "MinSizeRel" "RelWithDebInfo" "Coverage")
endif()
-project(LAPACK Fortran)
+string(TOUPPER ${CMAKE_BUILD_TYPE} CMAKE_BUILD_TYPE_UPPER)
+if(${CMAKE_BUILD_TYPE_UPPER} STREQUAL "COVERAGE")
+ message(STATUS "Adding coverage")
+ find_package(codecov)
+endif()
-set(LAPACK_MAJOR_VERSION 3)
-set(LAPACK_MINOR_VERSION 7)
-set(LAPACK_PATCH_VERSION 0)
-set(
- LAPACK_VERSION
- ${LAPACK_MAJOR_VERSION}.${LAPACK_MINOR_VERSION}.${LAPACK_PATCH_VERSION}
- )
+# By default static library
+option(BUILD_SHARED_LIBS "Build shared libraries" OFF)
+
+include(GNUInstallDirs)
# Updated OSX RPATH settings
# In response to CMake 3.0 generating warnings regarding policy CMP0042,
set(CMAKE_MACOSX_RPATH ON)
set(CMAKE_SKIP_BUILD_RPATH FALSE)
set(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE)
-list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${CMAKE_INSTALL_PREFIX}/lib${LIB_SUFFIX}" isSystemDir)
+list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES ${CMAKE_INSTALL_FULL_LIBDIR} isSystemDir)
if("${isSystemDir}" STREQUAL "-1")
- set(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib${LIB_SUFFIX}")
+ set(CMAKE_INSTALL_RPATH ${CMAKE_INSTALL_FULL_LIBDIR})
set(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE)
endif()
@ONLY
)
-# Add the CMake directory for custon CMake modules
-set(CMAKE_MODULE_PATH "${LAPACK_SOURCE_DIR}/CMAKE" ${CMAKE_MODULE_PATH})
include(PreventInSourceBuilds)
include(PreventInBuildInstalls)
set(LAPACK_INSTALL_EXPORT_NAME lapack-targets)
-if(UNIX)
- include(GNUInstallDirs)
- set(ARCHIVE_DIR ${CMAKE_INSTALL_LIBDIR})
- set(LIBRARY_DIR ${CMAKE_INSTALL_LIBDIR})
- set(RUNTIME_DIR ${CMAKE_INSTALL_BINDIR})
-else()
- set(ARCHIVE_DIR lib${LIB_SUFFIX})
- set(LIBRARY_DIR lib${LIB_SUFFIX})
- set(RUNTIME_DIR bin)
-endif()
-
macro(lapack_install_library lib)
install(TARGETS ${lib}
EXPORT ${LAPACK_INSTALL_EXPORT_NAME}
- ARCHIVE DESTINATION ${ARCHIVE_DIR}
- LIBRARY DESTINATION ${LIBRARY_DIR}
- RUNTIME DESTINATION ${RUNTIME_DIR}
+ ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR}
+ LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}
+ RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}
)
endmacro()
-set(PKG_CONFIG_DIR ${LIBRARY_DIR}/pkgconfig)
-set(prefix ${CMAKE_INSTALL_PREFIX})
-if(NOT IS_ABSOLUTE ${LIBRARY_DIR})
- set(libdir "\${prefix}/${LIBRARY_DIR}")
-else()
- set(libdir "${LIBRARY_DIR}")
-endif()
+set(PKG_CONFIG_DIR ${CMAKE_INSTALL_LIBDIR}/pkgconfig)
# --------------------------------------------------
# Testing
-
+option(BUILD_TESTING "Build tests" OFF)
enable_testing()
include(CTest)
enable_testing()
-# --------------------------------------------------
+message(STATUS "Build tests: ${BUILD_TESTING}")
+# --------------------------------------------------
# Organize output files. On Windows this also keeps .dll files next
# to the .exe files that need them, making tests easy to run.
set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${LAPACK_BINARY_DIR}/bin)
set(SECOND_SRC ${LAPACK_SOURCE_DIR}/INSTALL/second_${TIME_FUNC}.f)
set(DSECOND_SRC ${LAPACK_SOURCE_DIR}/INSTALL/dsecnd_${TIME_FUNC}.f)
-# By default static library
-option(BUILD_SHARED_LIBS "Build shared libraries" OFF)
-
-option(BUILD_TESTING "Build tests" OFF)
-
-# deprecated LAPACK routines
+# deprecated LAPACK and LAPACKE routines
option(BUILD_DEPRECATED "Build deprecated routines" OFF)
+message(STATUS "Build deprecated routines: ${BUILD_DEPRECATED}")
# --------------------------------------------------
# Precision to build
# By default all precisions are generated
-option(BUILD_SINGLE "Build LAPACK Single Precision" ON)
-option(BUILD_DOUBLE "Build LAPACK Double Precision" ON)
-option(BUILD_COMPLEX "Build LAPACK Complex Precision" ON)
-option(BUILD_COMPLEX16 "Build LAPACK Double Complex Precision" ON)
+option(BUILD_SINGLE "Build single precision real" ON)
+option(BUILD_DOUBLE "Build double precision real" ON)
+option(BUILD_COMPLEX "Build single precision complex" ON)
+option(BUILD_COMPLEX16 "Build double precision complex" ON)
+message(STATUS "Build single precision real: ${BUILD_SINGLE}")
+message(STATUS "Build double precision real: ${BUILD_DOUBLE}")
+message(STATUS "Build single precision complex: ${BUILD_COMPLEX}")
+message(STATUS "Build double precision complex: ${BUILD_COMPLEX16}")
+
+if(NOT (BUILD_SINGLE OR BUILD_DOUBLE OR BUILD_COMPLEX OR BUILD_COMPLEX16))
+ message(FATAL_ERROR "Nothing to build, no precision selected.
+ Please enable at least one of these:
+ BUILD_SINGLE, BUILD_DOUBLE, BUILD_COMPLEX, BUILD_COMPLEX16.")
+endif()
# --------------------------------------------------
# Subdirectories that need to be processed
CACHE STRING "Linker flags for shared libs" FORCE)
endif()
-message(STATUS "BUILD TESTING : ${BUILD_TESTING}")
if(BUILD_TESTING)
add_subdirectory(TESTING)
endif()
set(_lapack_config_install_guard_target "")
if(ALL_TARGETS)
install(EXPORT lapack-targets
- DESTINATION ${LIBRARY_DIR}/cmake/lapack-${LAPACK_VERSION})
+ DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapack-${LAPACK_VERSION})
# Choose one of the lapack targets to use as a guard for
# lapack-config.cmake to load targets from the install tree.
install(FILES
${LAPACK_BINARY_DIR}/CMakeFiles/lapack-config.cmake
${LAPACK_BINARY_DIR}/lapack-config-version.cmake
- DESTINATION ${LIBRARY_DIR}/cmake/lapack-${LAPACK_VERSION}
+ DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapack-${LAPACK_VERSION}
)
# could be handy for archiving the generated documentation or if some version
# control system is used.
-PROJECT_NUMBER = 3.7.0
+PROJECT_NUMBER = 3.8.0
# Using the PROJECT_BRIEF tag one can provide an optional one line description
# for a project that appears at the top of each page and should give viewer a
# could be handy for archiving the generated documentation or if some version
# control system is used.
-PROJECT_NUMBER = 3.7.0
+PROJECT_NUMBER = 3.8.0
# Using the PROJECT_BRIEF tag one can provide an optional one line description
# for a project that appears at the top of each page and should give viewer a
\begin{verbatim}
lapacklib:
- ( cd SRC; $(MAKE) single )
+ $(MAKE) -C SRC single
\end{verbatim}
Likewise, you could specify \texttt{double, complex, or complex16} to
\begin{list}{}{}
\item \texttt{cd LAPACK}
-\item \texttt{make clean}
+\item \texttt{make cleanobj}
\end{list}
\section{Further Details of the Installation Process}\label{furtherdetails}
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup auxOTHERauxiliary
*
-* ===================================================================== PROGRAM LAPACK_VERSION
+* =====================================================================
+ PROGRAM LAPACK_VERSION
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
INTEGER MAJOR, MINOR, PATCH
+* ..
+* .. External Subroutines ..
+ EXTERNAL ILAVER
*
- CALL ILAVER ( MAJOR,MINOR, PATCH )
+ CALL ILAVER ( MAJOR, MINOR, PATCH )
WRITE(*,*) "LAPACK ",MAJOR,".",MINOR,".",PATCH
*
END
include ../make.inc
-.SUFFIXES: .o .f
all: testlsame testslamch testdlamch testsecond testdsecnd testieee testversion
testlsame: lsame.o lsametst.o
- $(LOADER) $(LOADOPTS) -o $@ lsame.o lsametst.o
+ $(LOADER) $(LOADOPTS) -o $@ $^
testslamch: slamch.o lsame.o slamchtst.o
- $(LOADER) $(LOADOPTS) -o $@ slamch.o lsame.o slamchtst.o
+ $(LOADER) $(LOADOPTS) -o $@ $^
testdlamch: dlamch.o lsame.o dlamchtst.o
- $(LOADER) $(LOADOPTS) -o $@ dlamch.o lsame.o dlamchtst.o
+ $(LOADER) $(LOADOPTS) -o $@ $^
testsecond: second_$(TIMER).o secondtst.o
@echo "[INFO] : TIMER value: $(TIMER) (given by make.inc)"
- $(LOADER) $(LOADOPTS) -o $@ second_$(TIMER).o secondtst.o
+ $(LOADER) $(LOADOPTS) -o $@ $^
testdsecnd: dsecnd_$(TIMER).o dsecndtst.o
@echo "[INFO] : TIMER value: $(TIMER) (given by make.inc)"
- $(LOADER) $(LOADOPTS) -o $@ dsecnd_$(TIMER).o dsecndtst.o
+ $(LOADER) $(LOADOPTS) -o $@ $^
testieee: tstiee.o
- $(LOADER) $(LOADOPTS) -o $@ tstiee.o
+ $(LOADER) $(LOADOPTS) -o $@ $^
testversion: ilaver.o LAPACK_version.o
- $(LOADER) $(LOADOPTS) -o $@ ilaver.o LAPACK_version.o
-
-clean:
+ $(LOADER) $(LOADOPTS) -o $@ $^
+
+run: all
+ ./testlsame
+ ./testslamch
+ ./testdlamch
+ ./testsecond
+ ./testdsecnd
+ ./testieee
+ ./testversion
+
+clean: cleanobj cleanexe cleantest
+cleanobj:
rm -f *.o
+cleanexe:
+ rm -f test*
+cleantest:
+ rm -f core
+
+.SUFFIXES: .o .f
.f.o:
$(FORTRAN) $(OPTS) -c -o $@ $<
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup auxOTHERauxiliary
*
* ===================================================================== PROGRAM DSECNDTST
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* =====================================================================
*
DOUBLE PRECISION DSECND
EXTERNAL DSECND
* ..
+* .. External Subroutines ..
+ EXTERNAL MYSUB
+* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE
* ..
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* June 2016
+* June 2017
*
* =====================================================================
*
INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
* =====================================================================
VERS_MAJOR = 3
- VERS_MINOR = 7
+ VERS_MINOR = 8
VERS_PATCH = 0
* =====================================================================
*
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = cc
+CFLAGS = -O4
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+FORTRAN = f77
+OPTS = -O4 -fpe1
+DRVOPTS = $(OPTS)
+NOOPT =
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = f77
-OPTS = -O4 -fpe1
-DRVOPTS = $(OPTS)
-NOOPT =
LOADER = f77
LOADOPTS =
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = ranlib
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = cc
-CFLAGS = -O4
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = ranlib
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
#
#BLASLIB = ../../librefblas.a
-BLASLIB = -ldxml
+BLASLIB = -ldxml
CBLASLIB = ../../libcblas.a
LAPACKLIB = liblapack.a
TMGLIB = libtmglib.a
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = cc
+CFLAGS =
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+FORTRAN = f77
+OPTS = +O4 +U77
+DRVOPTS = $(OPTS) -K
+NOOPT = +U77
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = f77
-OPTS = +O4 +U77
-DRVOPTS = $(OPTS) -K
-NOOPT = +U77
LOADER = f77
LOADOPTS = -Aa +U77
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = echo
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = cc
-CFLAGS =
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = echo
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
#
#BLASLIB = ../../librefblas.a
-BLASLIB = -lblas
+BLASLIB = -lblas
CBLASLIB = ../../libcblas.a
LAPACKLIB = liblapack.a
TMGLIB = libtmglib.a
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /sbin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = cc
+CFLAGS = -O3
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+FORTRAN = f77
+OPTS = -O3 -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON
+#OPTS = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON
+DRVOPTS = $(OPTS) -static
+NOOPT = -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON
+#NOOPT = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = f77
-OPTS = -O3 -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON
-#OPTS = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON
-DRVOPTS = $(OPTS) -static
-NOOPT = -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON
-#NOOPT = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON
LOADER = f77
LOADOPTS = -O3 -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON
#LOADOPTS = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = echo
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = cc
-CFLAGS = -O3
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = echo
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
#
-#BLASLIB = -lblas
+#BLASLIB = -lblas
BLASLIB = ../../librefblas.a
CBLASLIB = ../../libcblas.a
LAPACKLIB = liblapack.a
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /sbin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = cc
+CFLAGS = -O3
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+FORTRAN = f77
+OPTS = -O3 -64 -mips4 -r10000
+#OPTS = -O3 -64 -mips4 -r10000 -mp
+DRVOPTS = $(OPTS) -static
+NOOPT = -64 -mips4 -r10000
+#NOOPT = -64 -mips4 -r10000 -mp
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = f77
-OPTS = -O3 -64 -mips4 -r10000
-#OPTS = -O3 -64 -mips4 -r10000 -mp
-DRVOPTS = $(OPTS) -static
-NOOPT = -64 -mips4 -r10000
-#NOOPT = -64 -mips4 -r10000 -mp
LOADER = f77
LOADOPTS = -O3 -64 -mips4 -r10000
#LOADOPTS = -O3 -64 -mips4 -r10000 -mp
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = echo
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = cc
-CFLAGS = -O3
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = echo
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
#
-BLASLIB = -lblas
-#BLASLIB = -lblas_mp
+BLASLIB = -lblas
+#BLASLIB = -lblas_mp
#BLASLIB = ../../librefblas.a
CBLASLIB = ../../libcblas.a
LAPACKLIB = liblapack.a
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /sbin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = cc
+CFLAGS = -O4
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+FORTRAN = f77
+OPTS = -O4
+DRVOPTS = $(OPTS) -static
+NOOPT =
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = f77
-OPTS = -O4
-DRVOPTS = $(OPTS) -static
-NOOPT =
LOADER = f77
LOADOPTS =
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = echo
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = cc
-CFLAGS = -O4
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = echo
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
#
-#BLASLIB = -lblas
+#BLASLIB = -lblas
BLASLIB = ../../librefblas.a
CBLASLIB = ../../libcblas.a
LAPACKLIB = liblapack.a
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = cc
+CFLAGS = -O3
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+FORTRAN = f77
+OPTS = -dalign -O4 -fast
+DRVOPTS = $(OPTS)
+NOOPT =
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = f77
-OPTS = -dalign -O4 -fast
-DRVOPTS = $(OPTS)
-NOOPT =
LOADER = f77
LOADOPTS = -dalign -O4 -fast
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = ranlib
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = cc
-CFLAGS = -O3
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = ranlib
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
#
-#BLASLIB = -lblas
+#BLASLIB = -lblas
BLASLIB = ../../librefblas.a
CBLASLIB = ../../libcblas.a
LAPACKLIB = liblapack.a
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = cc
+CFLAGS = -O3
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+FORTRAN = f77
+#OPTS = -O4 -u -f -mt
+#OPTS = -u -f -dalign -native -xO5 -xarch=v8plusa
+OPTS = -u -f -dalign -native -xO2 -xarch=v8plusa
+DRVOPTS = $(OPTS)
+NOOPT = -u -f
+#NOOPT = -u -f -mt
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = f77
-#OPTS = -O4 -u -f -mt
-#OPTS = -u -f -dalign -native -xO5 -xarch=v8plusa
-OPTS = -u -f -dalign -native -xO2 -xarch=v8plusa
-DRVOPTS = $(OPTS)
-NOOPT = -u -f
-#NOOPT = -u -f -mt
LOADER = f77
#LOADOPTS = -mt
LOADOPTS = -f -dalign -native -xO2 -xarch=v8plusa
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = echo
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = cc
-CFLAGS = -O3
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = echo
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
#
#BLASLIB = ../../librefblas.a
-#BLASLIB = -xlic_lib=sunperf_mt
-BLASLIB = -xlic_lib=sunperf
+#BLASLIB = -xlic_lib=sunperf_mt
+BLASLIB = -xlic_lib=sunperf
CBLASLIB = ../../libcblas.a
LAPACKLIB = liblapack.a
TMGLIB = libtmglib.a
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+CC = xlc
+CFLAGS = -O3 -qnosave
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-FORTRAN = xlf
-OPTS = -O3 -qfixed -qnosave
+FORTRAN = xlf
+OPTS = -O3 -qfixed -qnosave
# For -O2, add -qstrict=none
-DRVOPTS = $(OPTS)
-NOOPT = -O0 -qfixed -qnosave
+DRVOPTS = $(OPTS)
+NOOPT = -O0 -qfixed -qnosave
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
+#
LOADER = xlf
LOADOPTS = -qnosave
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-#TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = ranlib
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+#TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = xlc
-CFLAGS = -O3 -qnosave
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = ranlib
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
#
#BLASLIB = ../../librefblas.a
-BLASLIB = -lessl
+BLASLIB = -lessl
CBLASLIB = ../../libcblas.a
LAPACKLIB = liblapack.a
TMGLIB = libtmglib.a
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# November 2017 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+CC = gcc
+CFLAGS = -O3
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
# Note: During a regular execution, LAPACK might create NaN and Inf
# and handle these quantities appropriately. As a consequence, one
# should not compile LAPACK with flags such as -ffpe-trap=overflow.
#
-FORTRAN = gfortran
-OPTS = -O2 -frecursive
-DRVOPTS = $(OPTS)
-NOOPT = -O0 -frecursive
+FORTRAN = gfortran
+OPTS = -O2 -frecursive
+DRVOPTS = $(OPTS)
+NOOPT = -O0 -frecursive
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
+#
LOADER = gfortran
LOADOPTS =
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
+#
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = ranlib
+
+# Timer for the SECOND and DSECND routines
+#
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+#TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
+#
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-#TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
-#
-# CC is the C compiler, normally invoked with options CFLAGS.
-#
-CC = gcc
-CFLAGS = -O3
-#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = ranlib
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# November 2017 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader
-# and desired load options for your machine.
+CC = gcc
+CFLAGS = -g
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
# Note: During a regular execution, LAPACK might create NaN and Inf
# and handle these quantities appropriately. As a consequence, one
# should not compile LAPACK with flags such as -ffpe-trap=overflow.
#
-FORTRAN = gfortran -fimplicit-none -g -frecursive
-OPTS =
-DRVOPTS = $(OPTS)
-NOOPT = -g -O0 -frecursive
+FORTRAN = gfortran -fimplicit-none -g -frecursive
+OPTS =
+DRVOPTS = $(OPTS)
+NOOPT = -g -O0 -frecursive
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
+#
LOADER = gfortran -g
LOADOPTS =
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
+#
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = ranlib
+
+# Timer for the SECOND and DSECND routines
+#
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+#TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
+#
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-# TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the Fortran standard INTERNAL FUNCTION CPU_TIME
-TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
-#
-# CC is the C compiler, normally invoked with options CFLAGS.
-#
-CC = gcc
-CFLAGS = -g
-#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = ranlib
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# June 2016 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = icc
+CFLAGS = -O3
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader
-# and desired load options for your machine.
+FORTRAN = ifort
+OPTS = -O3 -fp-model strict -assume protect_parens
+DRVOPTS = $(OPTS)
+NOOPT = -O0 -fp-model strict -assume protect_parens
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = ifort
-OPTS = -O3 -fp-model strict -assume protect_parens
-DRVOPTS = $(OPTS)
-NOOPT = -O0 -fp-model strict -assume protect_parens
LOADER = ifort
LOADOPTS =
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the Fortran standard INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = ranlib
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = icc
-CFLAGS = -O3
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = ranlib
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = pgcc
+CFLAGS =
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+FORTRAN = pgf95
+OPTS = -O3
+DRVOPTS = $(OPTS)
+NOOPT = -O0
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = pgf95
-OPTS = -O3
-DRVOPTS = $(OPTS)
-NOOPT = -O0
LOADER = $(FORTRAN)
LOADOPTS =
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-# TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
- TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = echo
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+#TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = pgcc
-CFLAGS =
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = echo
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.6.0 #
-# November 2015 #
+# LAPACK, Version 3.7.0 #
+# December 2016 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
+#
+CC = pghpc
+CFLAGS =
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+FORTRAN = pghpf
+OPTS = -O4 -Mnohpfc -Mdclchk
+DRVOPTS = $(OPTS)
+NOOPT = -Mnohpfc -Mdclchk
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
#
-FORTRAN = pghpf
-OPTS = -O4 -Mnohpfc -Mdclchk
-DRVOPTS = $(OPTS)
-NOOPT = -Mnohpfc -Mdclchk
LOADER = pghpf
LOADOPTS =
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-# TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = echo
+
+# Timer for the SECOND and DSECND routines
#
-# CC is the C compiler, normally invoked with options CFLAGS.
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+#TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
-CC = pghpc
-CFLAGS =
+#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# LAPACKE has also the interface to some routines from tmglib,
-# if LAPACKE_WITH_TMG is selected, we need to add those routines to LAPACKE
#LAPACKE_WITH_TMG = Yes
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = echo
-#
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
#
-#BLASLIB = -lessl
+#BLASLIB = -lessl
BLASLIB = ../../librefblas.a
-CBLASLIB = ../../libcblas.a
+CBLASLIB = ../../libcblas.a
LAPACKLIB = liblapack.a
TMGLIB = libtmglib.a
LAPACKELIB = liblapacke.a
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup auxOTHERcomputational
*
* ===================================================================== PROGRAM SECONDTST
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* =====================================================================
*
REAL SECOND
EXTERNAL SECOND
* ..
+* .. External Subroutines ..
+ EXTERNAL MYSUB
+* ..
* .. Intrinsic Functions ..
INTRINSIC REAL
* ..
endmacro()
append_subdir_files(LAPACKE_INCLUDE "include")
-append_subdir_files(SRC_OBJ "src")
-append_subdir_files(SRCX_OBJ "src")
-append_subdir_files(MATGEN_OBJ "src")
-append_subdir_files(UTILS_OBJ "utils")
+append_subdir_files(SOURCES "src")
+append_subdir_files(DEPRECATED "src")
+append_subdir_files(EXTENDED "src")
+append_subdir_files(MATGEN "src")
+append_subdir_files(UTILS "utils")
+if(BUILD_DEPRECATED)
+ list(APPEND SOURCES ${DEPRECATED})
+endif()
if(USE_XBLAS)
- add_library(lapacke ${SRC_OBJ} ${SRCX_OBJ} ${UTILS_OBJ})
- target_link_libraries(lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES} ${XBLAS_LIBRARY})
-else()
- if(LAPACKE_WITH_TMG)
- add_library(lapacke ${SRC_OBJ} ${MATGEN_OBJ} ${UTILS_OBJ})
- target_link_libraries(lapacke tmglib ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
- else()
- add_library(lapacke ${SRC_OBJ} ${UTILS_OBJ})
- target_link_libraries(lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
- endif()
+ list(APPEND SOURCES ${EXTENDED})
+endif()
+if(LAPACKE_WITH_TMG)
+ list(APPEND SOURCES ${MATGEN})
+endif()
+list(APPEND SOURCES ${UTILS})
+
+add_library(lapacke ${SOURCES})
+set_target_properties(
+ lapacke PROPERTIES
+ LINKER_LANGUAGE C
+ VERSION ${LAPACK_VERSION}
+ SOVERSION ${LAPACK_MAJOR_VERSION}
+ )
+target_include_directories(lapacke PUBLIC
+ $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/../include>
+ $<INSTALL_INTERFACE:include>
+)
+
+if(LAPACKE_WITH_TMG)
+ target_link_libraries(lapacke PRIVATE tmglib)
endif()
+target_link_libraries(lapacke PRIVATE ${LAPACK_LIBRARIES})
lapack_install_library(lapacke)
-install(FILES ${LAPACKE_INCLUDE} ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h DESTINATION include)
+install(FILES ${LAPACKE_INCLUDE} ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR})
if(BUILD_TESTING)
add_subdirectory(example)
install(FILES
${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/lapacke-config.cmake
${LAPACK_BINARY_DIR}/lapacke-config-version.cmake
- DESTINATION ${LIBRARY_DIR}/cmake/lapacke-${LAPACK_VERSION}
+ DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapacke-${LAPACK_VERSION}
)
install(EXPORT lapacke-targets
- DESTINATION ${LIBRARY_DIR}/cmake/lapacke-${LAPACK_VERSION})
+ DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapacke-${LAPACK_VERSION})
# To generate lapacke library type 'make lapacke'
# To make both just type 'make'
#
-# To remove lapacke object files type 'make cleanlib'
+# To remove lapacke object files type 'make cleanobj'
# To clean all above type 'make clean'
# To clean everything including lapacke library type
# 'make cleanall'
all: lapacke
-lapacke:
- cd include && cp lapacke_mangling_with_flags.h.in lapacke_mangling.h
- cd src && $(MAKE)
- cd utils && $(MAKE)
+lapacke: include/lapacke_mangling.h
+ $(MAKE) -C src
+ $(MAKE) -C utils
-lapacke_example:
- cd example && $(MAKE)
+include/lapacke_mangling.h: include/lapacke_mangling_with_flags.h.in
+ cp $< $@
-clean: cleanlib
+lapacke_example: lapacke
+ $(MAKE) -C example
+#clean: cleanlib
+clean: cleanobj
+ $(MAKE) -C src clean
+ $(MAKE) -C utils clean
+ $(MAKE) -C example clean
+cleanobj:
+ $(MAKE) -C src cleanobj
+ $(MAKE) -C utils cleanobj
+ $(MAKE) -C example cleanobj
cleanlib:
- cd src && $(MAKE) clean
- cd utils && $(MAKE) clean
-
-cleanall: clean
- rm -f $(LAPACKE)
- cd example && $(MAKE) clean
+ rm -f ../$(LAPACKELIB)
+cleanexe:
+ $(MAKE) -C example cleanexe
get_filename_component(_LAPACKE_PREFIX "${_LAPACKE_PREFIX}" PATH)
# Load the LAPACK package with which we were built.
-set(LAPACK_DIR "${_LAPACKE_PREFIX}/@{LIBRARY_DIR@/cmake/lapack-@LAPACK_VERSION@")
+set(LAPACK_DIR "${_LAPACKE_PREFIX}/@CMAKE_INSTALL_LIBDIR@/cmake/lapack-@LAPACK_VERSION@")
find_package(LAPACK NO_MODULE)
# Load lapacke targets from the install tree.
add_executable(xexample_DGELS_rowmajor example_DGELS_rowmajor.c lapacke_example_aux.c lapacke_example_aux.h)
add_executable(xexample_DGELS_colmajor example_DGELS_colmajor.c lapacke_example_aux.c lapacke_example_aux.h)
-target_link_libraries(xexample_DGESV_rowmajor lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
-target_link_libraries(xexample_DGESV_colmajor lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
-target_link_libraries(xexample_DGELS_rowmajor lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
-target_link_libraries(xexample_DGELS_colmajor lapacke ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
+target_link_libraries(xexample_DGESV_rowmajor lapacke)
+target_link_libraries(xexample_DGESV_colmajor lapacke)
+target_link_libraries(xexample_DGELS_rowmajor lapacke)
+target_link_libraries(xexample_DGELS_colmajor lapacke)
add_test(example_DGESV_rowmajor ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGESV_rowmajor)
add_test(example_DGESV_colmajor ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGESV_colmajor)
# Double Precision Examples
xexample_DGESV_rowmajor: example_DGESV_rowmajor.o lapacke_example_aux.o $(LIBRARIES)
- $(LOADER) $(LOADOPTS) -o $@ example_DGESV_rowmajor.o lapacke_example_aux.o $(LIBRARIES)
+ $(LOADER) $(LOADOPTS) -o $@ $^
./$@
xexample_DGESV_colmajor: example_DGESV_colmajor.o lapacke_example_aux.o $(LIBRARIES)
- $(LOADER) $(LOADOPTS) -o $@ example_DGESV_colmajor.o lapacke_example_aux.o $(LIBRARIES)
+ $(LOADER) $(LOADOPTS) -o $@ $^
./$@
xexample_DGELS_rowmajor: example_DGELS_rowmajor.o lapacke_example_aux.o $(LIBRARIES)
- $(LOADER) $(LOADOPTS) -o $@ example_DGELS_rowmajor.o lapacke_example_aux.o $(LIBRARIES)
+ $(LOADER) $(LOADOPTS) -o $@ $^
./$@
xexample_DGELS_colmajor: example_DGELS_colmajor.o lapacke_example_aux.o $(LIBRARIES)
- $(LOADER) $(LOADOPTS) -o $@ example_DGELS_colmajor.o lapacke_example_aux.o $(LIBRARIES)
+ $(LOADER) $(LOADOPTS) -o $@ $^
./$@
+clean: cleanobj cleanexe
+cleanobj:
+ rm -f *.o
+cleanexe:
+ rm -f x*
+
.c.o:
$(CC) $(CFLAGS) -I. -I../include -c -o $@ $<
-
-clean:
- rm -f *.o x*
double LAPACKE_zlanhe( int matrix_layout, char norm, char uplo, lapack_int n,
const lapack_complex_double* a, lapack_int lda );
+lapack_int LAPACKE_clacrm( int matrix_layout, lapack_int m, lapack_int n,
+ const lapack_complex_float* a,
+ lapack_int lda, const float* b,
+ lapack_int ldb, lapack_complex_float* c,
+ lapack_int ldc );
+lapack_int LAPACKE_zlacrm( int matrix_layout, lapack_int m, lapack_int n,
+ const lapack_complex_double* a,
+ lapack_int lda, const double* b,
+ lapack_int ldb, lapack_complex_double* c,
+ lapack_int ldc );
+
+lapack_int LAPACKE_clarcm( int matrix_layout, lapack_int m, lapack_int n,
+ const float* a, lapack_int lda,
+ const lapack_complex_float* b,
+ lapack_int ldb, lapack_complex_float* c,
+ lapack_int ldc );
+lapack_int LAPACKE_zlarcm( int matrix_layout, lapack_int m, lapack_int n,
+ const double* a, lapack_int lda,
+ const lapack_complex_double* b,
+ lapack_int ldb, lapack_complex_double* c,
+ lapack_int ldc );
+
float LAPACKE_slansy( int matrix_layout, char norm, char uplo, lapack_int n,
const float* a, lapack_int lda );
double LAPACKE_dlansy( int matrix_layout, char norm, char uplo, lapack_int n,
lapack_int LAPACKE_slasrt( char id, lapack_int n, float* d );
lapack_int LAPACKE_dlasrt( char id, lapack_int n, double* d );
+lapack_int LAPACKE_slassq( lapack_int n, float* x, lapack_int incx, float* scale, float* sumsq );
+lapack_int LAPACKE_dlassq( lapack_int n, double* x, lapack_int incx, double* scale, double* sumsq );
+lapack_int LAPACKE_classq( lapack_int n, lapack_complex_float* x, lapack_int incx, float* scale, float* sumsq );
+lapack_int LAPACKE_zlassq( lapack_int n, lapack_complex_double* x, lapack_int incx, double* scale, double* sumsq );
+
lapack_int LAPACKE_slaswp( int matrix_layout, lapack_int n, float* a,
lapack_int lda, lapack_int k1, lapack_int k2,
const lapack_int* ipiv, lapack_int incx );
lapack_int lwork, double* rwork );
lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char range,
- lapack_int m, lapack_int n, float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- float* s, float* u, lapack_int ldu,
- float* vt, lapack_int ldvt,
- float* work, lapack_int lwork, lapack_int* iwork );
+ lapack_int m, lapack_int n, float* a,
+ lapack_int lda, float vl, float vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ float* s, float* u, lapack_int ldu,
+ float* vt, lapack_int ldvt,
+ float* work, lapack_int lwork, lapack_int* iwork );
lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char range,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- double* s, double* u, lapack_int ldu,
- double* vt, lapack_int ldvt,
- double* work, lapack_int lwork, lapack_int* iwork );
+ lapack_int m, lapack_int n, double* a,
+ lapack_int lda, double vl, double vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ double* s, double* u, lapack_int ldu,
+ double* vt, lapack_int ldvt,
+ double* work, lapack_int lwork, lapack_int* iwork );
lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char range,
- lapack_int m, lapack_int n, lapack_complex_float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- float* s, lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* vt, lapack_int ldvt,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int* iwork );
+ lapack_int m, lapack_int n, lapack_complex_float* a,
+ lapack_int lda, float vl, float vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ float* s, lapack_complex_float* u, lapack_int ldu,
+ lapack_complex_float* vt, lapack_int ldvt,
+ lapack_complex_float* work, lapack_int lwork,
+ float* rwork, lapack_int* iwork );
lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char range,
- lapack_int m, lapack_int n, lapack_complex_double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- double* s, lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* vt, lapack_int ldvt,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int* iwork );
+ lapack_int m, lapack_int n, lapack_complex_double* a,
+ lapack_int lda, double vl, double vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ double* s, lapack_complex_double* u, lapack_int ldu,
+ lapack_complex_double* vt, lapack_int ldvt,
+ lapack_complex_double* work, lapack_int lwork,
+ double* rwork, lapack_int* iwork );
lapack_int LAPACKE_sgesvj_work( int matrix_layout, char joba, char jobu,
char jobv, lapack_int m, lapack_int n, float* a,
lapack_int lda, float* sva, lapack_int mv,
lapack_complex_float* v, lapack_int ldv,
lapack_complex_float* cwork, lapack_int lwork,
- float* rwork,lapack_int lrwork );
+ float* rwork,lapack_int lrwork );
lapack_int LAPACKE_zgesvj_work( int matrix_layout, char joba, char jobu,
char jobv, lapack_int m, lapack_int n,
lapack_complex_double* a, lapack_int lda, double* sva,
lapack_int n, const lapack_complex_double* a,
lapack_int lda, double* work );
+lapack_int LAPACKE_clacrm_work( int matrix_layout, lapack_int m, lapack_int n,
+ const lapack_complex_float* a,
+ lapack_int lda, const float* b,
+ lapack_int ldb, lapack_complex_float* c,
+ lapack_int ldc, float* work );
+lapack_int LAPACKE_zlacrm_work( int matrix_layout, lapack_int m, lapack_int n,
+ const lapack_complex_double* a,
+ lapack_int lda, const double* b,
+ lapack_int ldb, lapack_complex_double* c,
+ lapack_int ldc, double* work );
+
+lapack_int LAPACKE_clarcm_work( int matrix_layout, lapack_int m, lapack_int n,
+ const float* a, lapack_int lda,
+ const lapack_complex_float* b,
+ lapack_int ldb, lapack_complex_float* c,
+ lapack_int ldc, float* work );
+lapack_int LAPACKE_zlarcm_work( int matrix_layout, lapack_int m, lapack_int n,
+ const double* a, lapack_int lda,
+ const lapack_complex_double* b,
+ lapack_int ldb, lapack_complex_double* c,
+ lapack_int ldc, double* work );
+
float LAPACKE_slansy_work( int matrix_layout, char norm, char uplo,
lapack_int n, const float* a, lapack_int lda,
float* work );
lapack_int LAPACKE_slasrt_work( char id, lapack_int n, float* d );
lapack_int LAPACKE_dlasrt_work( char id, lapack_int n, double* d );
+lapack_int LAPACKE_slassq_work( lapack_int n, float* x, lapack_int incx, float* scale, float* sumsq );
+lapack_int LAPACKE_dlassq_work( lapack_int n, double* x, lapack_int incx, double* scale, double* sumsq );
+lapack_int LAPACKE_classq_work( lapack_int n, lapack_complex_float* x, lapack_int incx, float* scale, float* sumsq );
+lapack_int LAPACKE_zlassq_work( lapack_int n, lapack_complex_double* x, lapack_int incx, double* scale, double* sumsq );
+
lapack_int LAPACKE_slaswp_work( int matrix_layout, lapack_int n, float* a,
lapack_int lda, lapack_int k1, lapack_int k2,
const lapack_int* ipiv, lapack_int incx );
lapack_int lda, lapack_complex_double* e, lapack_int* ipiv,
lapack_complex_double* b, lapack_int ldb,
lapack_complex_double* work, lapack_int lwork );
-
+
lapack_int LAPACKE_ssytrf_rk( int matrix_layout, char uplo, lapack_int n, float* a,
lapack_int lda, float* e, lapack_int* ipiv );
lapack_int LAPACKE_dsytrf_rk( int matrix_layout, char uplo, lapack_int n, double* a,
const lapack_int* ipiv, float anorm, float* rcond );
lapack_int LAPACKE_zsycon_3( int matrix_layout, char uplo, lapack_int n,
const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* e,
+ const lapack_complex_double* e,
const lapack_int* ipiv, double anorm,
double* rcond );
lapack_int LAPACKE_checon_3( int matrix_layout, char uplo, lapack_int n,
const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* e,
+ const lapack_complex_float* e,
const lapack_int* ipiv, float anorm, float* rcond );
lapack_int LAPACKE_zhecon_3( int matrix_layout, char uplo, lapack_int n,
const lapack_complex_double* a, lapack_int lda,
const lapack_complex_double* a, lapack_int lda,
const lapack_complex_double* e,
const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
+ double* rcond, lapack_complex_double* work );
lapack_int LAPACKE_checon_3_work( int matrix_layout, char uplo, lapack_int n,
const lapack_complex_float* a, lapack_int lda,
const lapack_complex_float* e,
double* w, lapack_complex_double* work,
lapack_int lwork, double* rwork );
+//LAPACK 3.8.0
+lapack_int LAPACKE_ssysv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, float* a, lapack_int lda,
+ float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, float* b, lapack_int ldb );
+lapack_int LAPACKE_ssysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, float* a, lapack_int lda,
+ float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, float* b, lapack_int ldb,
+ float* work, lapack_int lwork );
+lapack_int LAPACKE_dsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, double* a, lapack_int lda,
+ double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ double* b, lapack_int ldb );
+lapack_int LAPACKE_dsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, double* a, lapack_int lda,
+ double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ double* b, lapack_int ldb,
+ double* work, lapack_int lwork );
+lapack_int LAPACKE_csysv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb );
+lapack_int LAPACKE_csysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb,
+ lapack_complex_float* work, lapack_int lwork );
+lapack_int LAPACKE_zsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb );
+lapack_int LAPACKE_zsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb,
+ lapack_complex_double* work, lapack_int lwork );
+lapack_int LAPACKE_chesv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb );
+lapack_int LAPACKE_chesv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb,
+ lapack_complex_float* work, lapack_int lwork );
+lapack_int LAPACKE_zhesv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb );
+lapack_int LAPACKE_zhesv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb,
+ lapack_complex_double* work, lapack_int lwork );
+
+lapack_int LAPACKE_ssytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ float* a, lapack_int lda,
+ float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2 );
+lapack_int LAPACKE_ssytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ float* a, lapack_int lda,
+ float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2,
+ float* work, lapack_int lwork );
+lapack_int LAPACKE_dsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ double* a, lapack_int lda,
+ double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2 );
+lapack_int LAPACKE_dsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ double* a, lapack_int lda,
+ double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ double* work, lapack_int lwork );
+lapack_int LAPACKE_csytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 );
+lapack_int LAPACKE_csytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* work, lapack_int lwork );
+lapack_int LAPACKE_zsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 );
+lapack_int LAPACKE_zsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* work, lapack_int lwork );
+lapack_int LAPACKE_chetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 );
+lapack_int LAPACKE_chetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* work, lapack_int lwork );
+lapack_int LAPACKE_zhetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 );
+lapack_int LAPACKE_zhetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* work, lapack_int lwork );
+
+
+lapack_int LAPACKE_ssytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, float* a, lapack_int lda,
+ float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, float* b, lapack_int ldb );
+lapack_int LAPACKE_ssytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, float* a, lapack_int lda,
+ float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, float* b, lapack_int ldb );
+lapack_int LAPACKE_dsytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, double* a, lapack_int lda,
+ double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ double* b, lapack_int ldb );
+lapack_int LAPACKE_dsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, double* a, lapack_int lda,
+ double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ double* b, lapack_int ldb );
+lapack_int LAPACKE_csytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb );
+lapack_int LAPACKE_csytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb );
+lapack_int LAPACKE_zsytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb );
+lapack_int LAPACKE_zsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb );
+lapack_int LAPACKE_chetrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb );
+lapack_int LAPACKE_chetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb );
+lapack_int LAPACKE_zhetrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb );
+lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb );
+
#define LAPACK_sgetrf LAPACK_GLOBAL(sgetrf,SGETRF)
#define LAPACK_dgetrf LAPACK_GLOBAL(dgetrf,DGETRF)
#define LAPACK_cgetrf LAPACK_GLOBAL(cgetrf,CGETRF)
#define LAPACK_zlange LAPACK_GLOBAL(zlange,ZLANGE)
#define LAPACK_clanhe LAPACK_GLOBAL(clanhe,CLANHE)
#define LAPACK_zlanhe LAPACK_GLOBAL(zlanhe,ZLANHE)
+#define LAPACK_clarcm LAPACK_GLOBAL(clarcm,CLARCM)
+#define LAPACK_zlarcm LAPACK_GLOBAL(zlarcm,ZLARCM)
+#define LAPACK_clacrm LAPACK_GLOBAL(clacrm,CLACRM)
+#define LAPACK_zlacrm LAPACK_GLOBAL(zlacrm,ZLACRM)
#define LAPACK_slansy LAPACK_GLOBAL(slansy,SLANSY)
#define LAPACK_dlansy LAPACK_GLOBAL(dlansy,DLANSY)
#define LAPACK_clansy LAPACK_GLOBAL(clansy,CLANSY)
#define LAPACK_dlarfg LAPACK_GLOBAL(dlarfg,DLARFG)
#define LAPACK_clarfg LAPACK_GLOBAL(clarfg,CLARFG)
#define LAPACK_zlarfg LAPACK_GLOBAL(zlarfg,ZLARFG)
+#define LAPACK_slassq LAPACK_GLOBAL(slassq,SLASSQ)
+#define LAPACK_dlassq LAPACK_GLOBAL(dlassq,DLASSQ)
+#define LAPACK_classq LAPACK_GLOBAL(classq,CLASSQ)
+#define LAPACK_zlassq LAPACK_GLOBAL(zlassq,ZLASSQ)
#define LAPACK_slarft LAPACK_GLOBAL(slarft,SLARFT)
#define LAPACK_dlarft LAPACK_GLOBAL(dlarft,DLARFT)
#define LAPACK_clarft LAPACK_GLOBAL(clarft,CLARFT)
#define LAPACK_cgetsls LAPACK_GLOBAL(cgetsls,CGETSLS)
#define LAPACK_zgetsls LAPACK_GLOBAL(zgetsls,ZGETSLS)
+// LAPACK 3.8.0
+#define LAPACK_ssysv_aa_2stage LAPACK_GLOBAL(ssysv_aa_2stage,SSYSV_AA_2STAGE)
+#define LAPACK_dsysv_aa_2stage LAPACK_GLOBAL(dsysv_aa_2stage,DSYSV_AA_2STAGE)
+#define LAPACK_chesv_aa_2stage LAPACK_GLOBAL(chesv_aa_2stage,CHESV_AA_2STAGE)
+#define LAPACK_zsysv_aa_2stage LAPACK_GLOBAL(zsysv_aa_2stage,ZSYSV_AA_2STAGE)
+#define LAPACK_csysv_aa_2stage LAPACK_GLOBAL(csysv_aa_2stage,CSYSV_AA_2STAGE)
+#define LAPACK_zhesv_aa_2stage LAPACK_GLOBAL(zhesv_aa_2stage,ZHESV_AA_2STAGE)
+#define LAPACK_ssytrs_aa_2stage LAPACK_GLOBAL(ssytrs_aa_2stage,SSYTRS_AA_2STAGE)
+#define LAPACK_dsytrs_aa_2stage LAPACK_GLOBAL(dsytrs_aa_2stage,DSYTRS_AA_2STAGE)
+#define LAPACK_csytrs_aa_2stage LAPACK_GLOBAL(csytrs_aa_2stage,CSYTRS_AA_2STAGE)
+#define LAPACK_zsytrs_aa_2stage LAPACK_GLOBAL(zsytrs_aa_2stage,ZSYTRS_AA_2STAGE)
+#define LAPACK_chetrs_aa_2stage LAPACK_GLOBAL(chetrs_aa_2stage,CHETRS_AA_2STAGE)
+#define LAPACK_zhetrs_aa_2stage LAPACK_GLOBAL(zhetrs_aa_2stage,ZHETRS_AA_2STAGE)
+#define LAPACK_ssytrf_aa_2stage LAPACK_GLOBAL(ssytrf_aa_2stage,SSYTRF_AA_2STAGE)
+#define LAPACK_dsytrf_aa_2stage LAPACK_GLOBAL(dsytrf_aa_2stage,DSYTRF_AA_2STAGE)
+#define LAPACK_csytrf_aa_2stage LAPACK_GLOBAL(csytrf_aa_2stage,CSYTRF_AA_2STAGE)
+#define LAPACK_zsytrf_aa_2stage LAPACK_GLOBAL(zsytrf_aa_2stage,ZSYTRF_AA_2STAGE)
+#define LAPACK_chetrf_aa_2stage LAPACK_GLOBAL(chetrf_aa_2stage,CHETRF_AA_2STAGE)
+#define LAPACK_zhetrf_aa_2stage LAPACK_GLOBAL(zhetrf_aa_2stage,ZHETRF_AA_2STAGE)
+
void LAPACK_sgetrf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
lapack_int* ipiv, lapack_int *info );
const lapack_complex_float* a, lapack_int* lda, float* work );
double LAPACK_zlanhe( char* norm, char* uplo, lapack_int* n,
const lapack_complex_double* a, lapack_int* lda, double* work );
+void LAPACK_clarcm( lapack_int* m, lapack_int* n, const float* a,
+ lapack_int* lda, const lapack_complex_float* b,
+ lapack_int* ldb, lapack_complex_float* c,
+ lapack_int* ldc, float* work );
+void LAPACK_zlarcm( lapack_int* m, lapack_int* n, const double* a,
+ lapack_int* lda, const lapack_complex_double* b,
+ lapack_int* ldb, lapack_complex_double* c,
+ lapack_int* ldc, double* work );
+void LAPACK_clacrm( lapack_int* m, lapack_int* n, const lapack_complex_float* a,
+ lapack_int* lda, const float* b,
+ lapack_int* ldb, lapack_complex_float* c,
+ lapack_int* ldc, float* work );
+void LAPACK_zlacrm( lapack_int* m, lapack_int* n, const lapack_complex_double* a,
+ lapack_int* lda, const double* b,
+ lapack_int* ldb, lapack_complex_double* c,
+ lapack_int* ldc, double* work );
float LAPACK_slansy( char* norm, char* uplo, lapack_int* n, const float* a,
lapack_int* lda, float* work );
double LAPACK_dlansy( char* norm, char* uplo, lapack_int* n, const double* a,
void LAPACK_zlarfg( lapack_int* n, lapack_complex_double* alpha,
lapack_complex_double* x, lapack_int* incx,
lapack_complex_double* tau );
+void LAPACK_slassq( lapack_int *n, float* x, lapack_int *incx, float* scale, float* sumsq );
+void LAPACK_dlassq( lapack_int *n, double* x, lapack_int *incx, double* scale, double* sumsq );
+void LAPACK_classq( lapack_int *n, lapack_complex_float* x, lapack_int *incx, float* scale, float* sumsq );
+void LAPACK_zlassq( lapack_int *n, lapack_complex_double* x, lapack_int *incx, double* scale, double* sumsq );
void LAPACK_slarft( char* direct, char* storev, lapack_int* n, lapack_int* k,
const float* v, lapack_int* ldv, const float* tau, float* t,
lapack_int* ldt );
const lapack_int* ipiv,
lapack_complex_double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_ssytri_3( char* uplo, lapack_int* n, float* a, lapack_int* lda, const float* e,
+void LAPACK_ssytri_3( char* uplo, lapack_int* n, float* a, lapack_int* lda, const float* e,
const lapack_int* ipiv, float* work, lapack_int* lwork, lapack_int *info );
void LAPACK_dsytri_3( char* uplo, lapack_int* n, double* a, lapack_int* lda, const double* e,
const lapack_int* ipiv, double* work, lapack_int* lwork, lapack_int *info );
lapack_int* lda, const lapack_complex_double* e, const lapack_int* ipiv,
lapack_complex_double* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_ssycon_3( char* uplo, lapack_int* n, const float* a, lapack_int* lda, const float* e,
+void LAPACK_ssycon_3( char* uplo, lapack_int* n, const float* a, lapack_int* lda, const float* e,
const lapack_int* ipiv, float* anorm, float* rcond,
float* work, lapack_int* iwork, lapack_int *info );
void LAPACK_dsycon_3( char* uplo, lapack_int* n, const double* a, lapack_int* lda, const double* e,
lapack_complex_double* work, lapack_int* lwork,
double* rwork, lapack_int *info );
+//LAPACK 3.8.0
+
+void LAPACK_ssysv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ float* a, lapack_int* lda, float* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2, float* b, lapack_int* ldb,
+ float* work, lapack_int* lwork, lapack_int *info );
+void LAPACK_dsysv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, double* a,
+ lapack_int* lda, double* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2, double* b,
+ lapack_int* ldb, double* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_csysv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ lapack_complex_float* a, lapack_int* lda,
+ lapack_complex_float* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int* ldb,
+ lapack_complex_float* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_zsysv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ lapack_complex_double* a, lapack_int* lda,
+ lapack_complex_double* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int* ldb,
+ lapack_complex_double* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_chesv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ lapack_complex_float* a, lapack_int* lda,
+ lapack_complex_float* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int* ldb,
+ lapack_complex_float* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_zhesv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ lapack_complex_double* a, lapack_int* lda,
+ lapack_complex_double* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int* ldb,
+ lapack_complex_double* work, lapack_int* lwork,
+ lapack_int *info );
+
+void LAPACK_ssytrf_aa_2stage( char* uplo, lapack_int* n,
+ float* a, lapack_int* lda, float* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ float* work, lapack_int* lwork, lapack_int *info );
+void LAPACK_dsytrf_aa_2stage( char* uplo, lapack_int* n, double* a,
+ lapack_int* lda, double* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ double* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_csytrf_aa_2stage( char* uplo, lapack_int* n,
+ lapack_complex_float* a, lapack_int* lda,
+ lapack_complex_float* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_zsytrf_aa_2stage( char* uplo, lapack_int* n,
+ lapack_complex_double* a, lapack_int* lda,
+ lapack_complex_double* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_chetrf_aa_2stage( char* uplo, lapack_int* n,
+ lapack_complex_float* a, lapack_int* lda,
+ lapack_complex_float* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_zhetrf_aa_2stage( char* uplo, lapack_int* n,
+ lapack_complex_double* a, lapack_int* lda,
+ lapack_complex_double* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* work, lapack_int* lwork,
+ lapack_int *info );
+
+void LAPACK_ssytrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ float* a, lapack_int* lda, float* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2, float* b, lapack_int* ldb,
+ lapack_int *info );
+void LAPACK_dsytrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, double* a,
+ lapack_int* lda, double* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2, double* b,
+ lapack_int* ldb, lapack_int *info );
+void LAPACK_csytrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ lapack_complex_float* a, lapack_int* lda,
+ lapack_complex_float* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int* ldb,
+ lapack_int *info );
+void LAPACK_zsytrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ lapack_complex_double* a, lapack_int* lda,
+ lapack_complex_double* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int* ldb,
+ lapack_int *info );
+void LAPACK_chetrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ lapack_complex_float* a, lapack_int* lda,
+ lapack_complex_float* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int* ldb,
+ lapack_int *info );
+void LAPACK_zhetrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs,
+ lapack_complex_double* a, lapack_int* lda,
+ lapack_complex_double* tb, lapack_int* ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int* ldb,
+ lapack_int *info );
+
+/* APIs for set/get nancheck flags */
+void LAPACKE_set_nancheck( int flag );
+int LAPACKE_get_nancheck( );
+
#ifdef __cplusplus
}
#endif /* __cplusplus */
-prefix=@prefix@
-libdir=@libdir@
+libdir=@CMAKE_INSTALL_FULL_LIBDIR@
+includedir=@CMAKE_INSTALL_FULL_INCLUDEDIR@
Name: LAPACKE
Description: C Standard Interface to LAPACK Linear Algebra PACKage
Version: @LAPACK_VERSION@
URL: http://www.netlib.org/lapack/#_standard_c_language_apis_for_lapack
Libs: -L${libdir} -llapacke
-Requires: lapack blas
+Cflags: -I${includedir}
+Requires.private: lapack
-#aux_source_directory(${CMAKE_CURRENT_SOURCE_DIR} SRC_OBJ)
-
-set(SRC_OBJ
+set(SOURCES
lapacke_cbbcsd.c
lapacke_cbbcsd_work.c
lapacke_cbdsqr.c
lapacke_cgehrd_work.c
lapacke_cgejsv.c
lapacke_cgejsv_work.c
+lapacke_cgelq.c
+lapacke_cgelq_work.c
lapacke_cgelq2.c
lapacke_cgelq2_work.c
lapacke_cgelqf.c
lapacke_cgelss_work.c
lapacke_cgelsy.c
lapacke_cgelsy_work.c
+lapacke_cgemlq.c
+lapacke_cgemlq_work.c
lapacke_cgemqr.c
lapacke_cgemqr_work.c
lapacke_cgemqrt.c
lapacke_cgeqlf_work.c
lapacke_cgeqp3.c
lapacke_cgeqp3_work.c
+lapacke_cgeqr.c
+lapacke_cgeqr_work.c
lapacke_cgeqr2.c
lapacke_cgeqr2_work.c
lapacke_cgeqrf.c
lapacke_chesv.c
lapacke_chesv_work.c
lapacke_chesv_aa.c
+lapacke_chesv_aa_2stage.c
lapacke_chesv_aa_work.c
+lapacke_chesv_aa_2stage_work.c
lapacke_chesv_rk.c
lapacke_chesv_rk_work.c
lapacke_chesvx.c
lapacke_chetrf_work.c
lapacke_chetrf_rook_work.c
lapacke_chetrf_aa.c
+lapacke_chetrf_aa_2stage.c
lapacke_chetrf_aa_work.c
+lapacke_chetrf_aa_2stage_work.c
lapacke_chetrf_rk.c
lapacke_chetrf_rk_work.c
lapacke_chetri.c
lapacke_chetrs_work.c
lapacke_chetrs_rook_work.c
lapacke_chetrs_aa.c
+lapacke_chetrs_aa_2stage.c
lapacke_chetrs_aa_work.c
+lapacke_chetrs_aa_2stage_work.c
lapacke_chetrs_3.c
lapacke_chetrs_3_work.c
lapacke_chfrk.c
lapacke_clacp2_work.c
lapacke_clacpy.c
lapacke_clacpy_work.c
+lapacke_clacrm.c
+lapacke_clacrm_work.c
lapacke_clag2z.c
lapacke_clag2z_work.c
lapacke_clange.c
lapacke_clapmr_work.c
lapacke_clapmt.c
lapacke_clapmt_work.c
+lapacke_clarcm.c
+lapacke_clarcm_work.c
lapacke_clarfb.c
lapacke_clarfb_work.c
lapacke_clarfg.c
lapacke_clascl_work.c
lapacke_claset.c
lapacke_claset_work.c
+lapacke_classq.c
+lapacke_classq_work.c
lapacke_claswp.c
lapacke_claswp_work.c
lapacke_clauum.c
lapacke_csysv_rook_work.c
lapacke_csysv_work.c
lapacke_csysv_aa.c
+lapacke_csysv_aa_2stage.c
lapacke_csysv_aa_work.c
+lapacke_csysv_aa_2stage_work.c
lapacke_csysv_rk.c
lapacke_csysv_rk_work.c
lapacke_csysvx.c
lapacke_csytrf_rook.c
lapacke_csytrf_rook_work.c
lapacke_csytrf_aa.c
+lapacke_csytrf_aa_2stage.c
lapacke_csytrf_aa_work.c
+lapacke_csytrf_aa_2stage_work.c
lapacke_csytrf_rk.c
lapacke_csytrf_rk_work.c
lapacke_csytri.c
lapacke_csytrs_work.c
lapacke_csytrs_rook_work.c
lapacke_csytrs_aa.c
+lapacke_csytrs_aa_2stage.c
lapacke_csytrs_aa_work.c
+lapacke_csytrs_aa_2stage_work.c
lapacke_csytrs_3.c
lapacke_csytrs_3_work.c
lapacke_ctbcon.c
lapacke_dgehrd_work.c
lapacke_dgejsv.c
lapacke_dgejsv_work.c
+lapacke_dgelq.c
+lapacke_dgelq_work.c
lapacke_dgelq2.c
lapacke_dgelq2_work.c
lapacke_dgelqf.c
lapacke_dgelss_work.c
lapacke_dgelsy.c
lapacke_dgelsy_work.c
+lapacke_dgemlq.c
+lapacke_dgemlq_work.c
lapacke_dgemqr.c
lapacke_dgemqr_work.c
lapacke_dgemqrt.c
lapacke_dgeqlf_work.c
lapacke_dgeqp3.c
lapacke_dgeqp3_work.c
+lapacke_dgeqr.c
+lapacke_dgeqr_work.c
lapacke_dgeqr2.c
lapacke_dgeqr2_work.c
lapacke_dgeqrf.c
lapacke_dlaset_work.c
lapacke_dlasrt.c
lapacke_dlasrt_work.c
+lapacke_dlassq.c
+lapacke_dlassq_work.c
lapacke_dlaswp.c
lapacke_dlaswp_work.c
lapacke_dlauum.c
lapacke_dsysv_rook_work.c
lapacke_dsysv_work.c
lapacke_dsysv_aa.c
+lapacke_dsysv_aa_2stage.c
lapacke_dsysv_aa_work.c
+lapacke_dsysv_aa_2stage_work.c
lapacke_dsysv_rk.c
lapacke_dsysv_rk_work.c
lapacke_dsysvx.c
lapacke_dsytrf_rook.c
lapacke_dsytrf_rook_work.c
lapacke_dsytrf_aa.c
+lapacke_dsytrf_aa_2stage.c
lapacke_dsytrf_aa_work.c
+lapacke_dsytrf_aa_2stage_work.c
lapacke_dsytrf_rk.c
lapacke_dsytrf_rk_work.c
lapacke_dsytri.c
lapacke_dsytrs2.c
lapacke_dsytrs2_work.c
lapacke_dsytrs_aa.c
+lapacke_dsytrs_aa_2stage.c
lapacke_dsytrs_aa_work.c
+lapacke_dsytrs_aa_2stage_work.c
lapacke_dsytrs_3.c
lapacke_dsytrs_3_work.c
lapacke_dsytrs_work.c
lapacke_dtrttp_work.c
lapacke_dtzrzf.c
lapacke_dtzrzf_work.c
+lapacke_nancheck.c
lapacke_sbbcsd.c
lapacke_sbbcsd_work.c
lapacke_sbdsdc.c
lapacke_sgehrd_work.c
lapacke_sgejsv.c
lapacke_sgejsv_work.c
+lapacke_sgelq.c
+lapacke_sgelq_work.c
lapacke_sgelq2.c
lapacke_sgelq2_work.c
lapacke_sgelqf.c
lapacke_sgelss_work.c
lapacke_sgelsy.c
lapacke_sgelsy_work.c
+lapacke_sgemlq.c
+lapacke_sgemlq_work.c
lapacke_sgemqr.c
lapacke_sgemqr_work.c
lapacke_sgemqrt.c
lapacke_sgeqlf_work.c
lapacke_sgeqp3.c
lapacke_sgeqp3_work.c
+lapacke_sgeqr.c
+lapacke_sgeqr_work.c
lapacke_sgeqr2.c
lapacke_sgeqr2_work.c
lapacke_sgeqrf.c
lapacke_slaset_work.c
lapacke_slasrt.c
lapacke_slasrt_work.c
+lapacke_slassq.c
+lapacke_slassq_work.c
lapacke_slaswp.c
lapacke_slaswp_work.c
lapacke_slauum.c
lapacke_ssysv_work.c
lapacke_ssysv_aa.c
lapacke_ssysv_aa_work.c
+lapacke_ssysv_aa_2stage.c
+lapacke_ssysv_aa_2stage_work.c
lapacke_ssysv_rk.c
lapacke_ssysv_rk_work.c
lapacke_ssysvx.c
lapacke_ssytrf_rook.c
lapacke_ssytrf_rook_work.c
lapacke_ssytrf_aa.c
+lapacke_ssytrf_aa_2stage.c
lapacke_ssytrf_aa_work.c
+lapacke_ssytrf_aa_2stage_work.c
lapacke_ssytrf_rk.c
lapacke_ssytrf_rk_work.c
lapacke_ssytri.c
lapacke_ssytrs2.c
lapacke_ssytrs2_work.c
lapacke_ssytrs_aa.c
+lapacke_ssytrs_aa_2stage.c
lapacke_ssytrs_aa_work.c
+lapacke_ssytrs_aa_2stage_work.c
lapacke_ssytrs_3.c
lapacke_ssytrs_3_work.c
lapacke_ssytrs_work.c
lapacke_zgehrd_work.c
lapacke_zgejsv.c
lapacke_zgejsv_work.c
+lapacke_zgelq.c
+lapacke_zgelq_work.c
lapacke_zgelq2.c
lapacke_zgelq2_work.c
lapacke_zgelqf.c
lapacke_zgelss_work.c
lapacke_zgelsy.c
lapacke_zgelsy_work.c
+lapacke_zgemlq.c
+lapacke_zgemlq_work.c
lapacke_zgemqr.c
lapacke_zgemqr_work.c
lapacke_zgemqrt.c
lapacke_zgeqlf_work.c
lapacke_zgeqp3.c
lapacke_zgeqp3_work.c
+lapacke_zgeqr.c
+lapacke_zgeqr_work.c
lapacke_zgeqr2.c
lapacke_zgeqr2_work.c
lapacke_zgeqrf.c
lapacke_zhbevd_work.c
lapacke_zhbevx.c
lapacke_zhbevx_work.c
+lapacke_zhbev_2stage.c
+lapacke_zhbev_2stage_work.c
+lapacke_zhbevd_2stage.c
+lapacke_zhbevd_2stage_work.c
+lapacke_zhbevx_2stage.c
+lapacke_zhbevx_2stage_work.c
lapacke_zhbgst.c
lapacke_zhbgst_work.c
lapacke_zhbgv.c
lapacke_zhesv.c
lapacke_zhesv_work.c
lapacke_zhesv_aa.c
+lapacke_zhesv_aa_2stage.c
lapacke_zhesv_aa_work.c
+lapacke_zhesv_aa_2stage_work.c
lapacke_zhesv_rk.c
lapacke_zhesv_rk_work.c
lapacke_zhesvx.c
lapacke_zhetrf_work.c
lapacke_zhetrf_rook_work.c
lapacke_zhetrf_aa.c
+lapacke_zhetrf_aa_2stage.c
lapacke_zhetrf_aa_work.c
+lapacke_zhetrf_aa_2stage_work.c
lapacke_zhetrf_rk.c
lapacke_zhetrf_rk_work.c
lapacke_zhetri.c
lapacke_zhetrs2_work.c
lapacke_zhetrs_work.c
lapacke_zhetrs_aa.c
+lapacke_zhetrs_aa_2stage.c
lapacke_zhetrs_aa_work.c
+lapacke_zhetrs_aa_2stage_work.c
lapacke_zhetrs_3.c
lapacke_zhetrs_3_work.c
lapacke_zhetrs_rook_work.c
lapacke_zlacp2_work.c
lapacke_zlacpy.c
lapacke_zlacpy_work.c
+lapacke_zlacrm.c
+lapacke_zlacrm_work.c
lapacke_zlag2c.c
lapacke_zlag2c_work.c
lapacke_zlange.c
lapacke_zlapmr_work.c
lapacke_zlapmt.c
lapacke_zlapmt_work.c
+lapacke_zlarcm.c
+lapacke_zlarcm_work.c
lapacke_zlarfb.c
lapacke_zlarfb_work.c
lapacke_zlarfg.c
lapacke_zlascl_work.c
lapacke_zlaset.c
lapacke_zlaset_work.c
+lapacke_zlassq.c
+lapacke_zlassq_work.c
lapacke_zlaswp.c
lapacke_zlaswp_work.c
lapacke_zlauum.c
lapacke_zsysv_rook_work.c
lapacke_zsysv_work.c
lapacke_zsysv_aa.c
+lapacke_zsysv_aa_2stage.c
lapacke_zsysv_aa_work.c
+lapacke_zsysv_aa_2stage_work.c
lapacke_zsysv_rk.c
lapacke_zsysv_rk_work.c
lapacke_zsysvx.c
lapacke_zsytrf_rook.c
lapacke_zsytrf_rook_work.c
lapacke_zsytrf_aa.c
+lapacke_zsytrf_aa_2stage.c
lapacke_zsytrf_aa_work.c
+lapacke_zsytrf_aa_2stage_work.c
lapacke_zsytrf_rk.c
lapacke_zsytrf_rk_work.c
lapacke_zsytri.c
lapacke_zsytrs_work.c
lapacke_zsytrs_rook_work.c
lapacke_zsytrs_aa.c
+lapacke_zsytrs_aa_2stage.c
lapacke_zsytrs_aa_work.c
+lapacke_zsytrs_aa_2stage_work.c
lapacke_zsytrs_3.c
lapacke_zsytrs_3_work.c
lapacke_ztbcon.c
lapacke_ilaver.c
)
-if(BUILD_DEPRECATED)
- list(APPEND SRC_OBJ
- lapacke_cggsvp.c
- lapacke_cggsvp_work.c
- lapacke_dggsvp.c
- lapacke_dggsvp_work.c
- lapacke_sggsvp.c
- lapacke_sggsvp_work.c
- lapacke_zggsvp.c
- lapacke_zggsvp_work.c
- lapacke_cggsvd.c
- lapacke_cggsvd_work.c
- lapacke_dggsvd.c
- lapacke_dggsvd_work.c
- lapacke_sggsvd.c
- lapacke_sggsvd_work.c
- lapacke_zggsvd.c
- lapacke_zggsvd_work.c
- lapacke_cgeqpf.c
- lapacke_cgeqpf_work.c
- lapacke_dgeqpf.c
- lapacke_dgeqpf_work.c
- lapacke_sgeqpf.c
- lapacke_sgeqpf_work.c
- lapacke_zgeqpf.c
- lapacke_zgeqpf_work.c)
- message(STATUS "Building LAPACKE deprecated routines")
-endif()
+set(DEPRECATED
+lapacke_cggsvp.c
+lapacke_cggsvp_work.c
+lapacke_dggsvp.c
+lapacke_dggsvp_work.c
+lapacke_sggsvp.c
+lapacke_sggsvp_work.c
+lapacke_zggsvp.c
+lapacke_zggsvp_work.c
+lapacke_cggsvd.c
+lapacke_cggsvd_work.c
+lapacke_dggsvd.c
+lapacke_dggsvd_work.c
+lapacke_sggsvd.c
+lapacke_sggsvd_work.c
+lapacke_zggsvd.c
+lapacke_zggsvd_work.c
+lapacke_cgeqpf.c
+lapacke_cgeqpf_work.c
+lapacke_dgeqpf.c
+lapacke_dgeqpf_work.c
+lapacke_sgeqpf.c
+lapacke_sgeqpf_work.c
+lapacke_zgeqpf.c
+lapacke_zgeqpf_work.c
+)
-set(SRCX_OBJ
+set(EXTENDED
lapacke_cgbrfsx.c lapacke_cporfsx.c lapacke_dgerfsx.c lapacke_sgbrfsx.c lapacke_ssyrfsx.c lapacke_zherfsx.c
lapacke_cgbrfsx_work.c lapacke_cporfsx_work.c lapacke_dgerfsx_work.c lapacke_sgbrfsx_work.c lapacke_ssyrfsx_work.c lapacke_zherfsx_work.c
lapacke_cgerfsx.c lapacke_csyrfsx.c lapacke_dporfsx.c lapacke_sgerfsx.c lapacke_zgbrfsx.c lapacke_zporfsx.c
)
# FILE PARTS OF TMGLIB
-set(MATGEN_OBJ
+set(MATGEN
lapacke_clatms.c
lapacke_clatms_work.c
lapacke_dlatms.c
##############################################################################
# makefile for LAPACKE, used to build lapacke binary.
#
+# Note: we use multiple OBJ_A, OBJ_B, etc, instead of a single OBJ
+# to allow build with mingw (argument list too long for the msys ar)
+#
include ../../make.inc
-SRC_OBJA = \
+OBJ_A = \
lapacke_cbbcsd.o \
lapacke_cbbcsd_work.o \
lapacke_cbdsqr.o \
lapacke_cgeevx_work.o \
lapacke_cgehrd.o \
lapacke_cgehrd_work.o \
+lapacke_cgelq.o \
+lapacke_cgelq_work.o \
lapacke_cgelq2.o \
lapacke_cgelq2_work.o \
lapacke_cgejsv.o \
lapacke_cgelss_work.o \
lapacke_cgelsy.o \
lapacke_cgelsy_work.o \
+lapacke_cgemlq.o \
+lapacke_cgemlq_work.o \
lapacke_cgemqr.o \
lapacke_cgemqr_work.o \
lapacke_cgemqrt.o \
lapacke_cgeqlf_work.o \
lapacke_cgeqp3.o \
lapacke_cgeqp3_work.o \
+lapacke_cgeqr.o \
+lapacke_cgeqr_work.o \
lapacke_cgeqr2.o \
lapacke_cgeqr2_work.o \
lapacke_cgeqrf.o \
lapacke_chesv_work.o \
lapacke_chesv_aa.o \
lapacke_chesv_aa_work.o \
+lapacke_chesv_aa_2stage.o \
+lapacke_chesv_aa_2stage_work.o \
lapacke_chesv_rk.o \
lapacke_chesv_rk_work.o \
lapacke_chesvx.o \
lapacke_chetrf_work.o \
lapacke_chetrf_rook_work.o \
lapacke_chetrf_aa.o \
+lapacke_chetrf_aa_2stage.o \
lapacke_chetrf_aa_work.o \
+lapacke_chetrf_aa_2stage_work.o \
lapacke_chetrf_rk.o \
lapacke_chetrf_rk_work.o \
lapacke_chetri.o \
lapacke_chetrs_work.o \
lapacke_chetrs_rook_work.o \
lapacke_chetrs_aa.o \
+lapacke_chetrs_aa_2stage.o \
lapacke_chetrs_aa_work.o \
+lapacke_chetrs_aa_2stage_work.o \
lapacke_chetrs_3.o \
lapacke_chetrs_3_work.o \
lapacke_chfrk.o \
lapacke_clacp2_work.o \
lapacke_clacpy.o \
lapacke_clacpy_work.o \
+lapacke_clacrm.o \
+lapacke_clacrm_work.o \
lapacke_clag2z.o \
lapacke_clag2z_work.o \
lapacke_clange.o \
lapacke_clapmr_work.o \
lapacke_clapmt.o \
lapacke_clapmt_work.o \
+lapacke_clarcm.o \
+lapacke_clarcm_work.o \
lapacke_clarfb.o \
lapacke_clarfb_work.o \
lapacke_clarfg.o \
lapacke_clascl_work.o \
lapacke_claset.o \
lapacke_claset_work.o \
+lapacke_classq.o \
+lapacke_classq_work.o \
lapacke_claswp.o \
lapacke_claswp_work.o \
lapacke_clauum.o \
lapacke_csysv_work.o \
lapacke_csysv_aa.o \
lapacke_csysv_aa_work.o \
+lapacke_csysv_aa_2stage.o \
+lapacke_csysv_aa_2stage_work.o \
lapacke_csysv_rk.o \
lapacke_csysv_rk_work.o \
lapacke_csysvx.o \
lapacke_csytrf_rook.o \
lapacke_csytrf_rook_work.o \
lapacke_csytrf_aa.o \
+lapacke_csytrf_aa_2stage.o \
lapacke_csytrf_aa_work.o \
+lapacke_csytrf_aa_2stage_work.o \
lapacke_csytrf_rk.o \
lapacke_csytrf_rk_work.o \
lapacke_csytri.o \
lapacke_csytrs_work.o \
lapacke_csytrs_rook_work.o \
lapacke_csytrs_aa.o \
+lapacke_csytrs_aa_2stage.o \
lapacke_csytrs_aa_work.o \
+lapacke_csytrs_aa_2stage_work.o \
lapacke_csytrs_3.o \
lapacke_csytrs_3_work.o \
lapacke_ctbcon.o \
lapacke_dgehrd_work.o \
lapacke_dgejsv.o \
lapacke_dgejsv_work.o \
+lapacke_dgelq.o \
+lapacke_dgelq_work.o \
lapacke_dgelq2.o \
lapacke_dgelq2_work.o \
lapacke_dgelqf.o \
lapacke_dgelss_work.o \
lapacke_dgelsy.o \
lapacke_dgelsy_work.o \
+lapacke_dgemlq.o \
+lapacke_dgemlq_work.o \
lapacke_dgemqr.o \
lapacke_dgemqr_work.o \
lapacke_dgemqrt.o \
lapacke_dgeqlf_work.o \
lapacke_dgeqp3.o \
lapacke_dgeqp3_work.o \
+lapacke_dgeqr.o \
+lapacke_dgeqr_work.o \
lapacke_dgeqr2.o \
lapacke_dgeqr2_work.o \
lapacke_dgeqrf.o \
lapacke_dlaset_work.o \
lapacke_dlasrt.o \
lapacke_dlasrt_work.o \
+lapacke_dlassq.o \
+lapacke_dlassq_work.o \
lapacke_dlaswp.o \
lapacke_dlaswp_work.o \
lapacke_dlauum.o \
lapacke_dsysv_work.o \
lapacke_dsysv_aa.o \
lapacke_dsysv_aa_work.o \
+lapacke_dsysv_aa_2stage.o \
+lapacke_dsysv_aa_2stage_work.o \
lapacke_dsysv_rk.o \
lapacke_dsysv_rk_work.o \
lapacke_dsysvx.o \
lapacke_dsytrf_rook_work.o \
lapacke_dsytrf_aa.o \
lapacke_dsytrf_aa_work.o \
+lapacke_dsytrf_aa_2stage.o \
+lapacke_dsytrf_aa_2stage_work.o \
lapacke_dsytrf_rk.o \
lapacke_dsytrf_rk_work.o \
lapacke_dsytri.o \
lapacke_dsytri_3_work.o \
lapacke_dsytri2x.o \
lapacke_dsytri2x_work.o \
-lapacke_dsytri_work.o
+lapacke_dsytri_work.o
-SRC_OBJB = \
+OBJ_B = \
lapacke_dsytrs.o \
lapacke_dsytrs_rook.o \
lapacke_dsytrs2.o \
lapacke_dsytrs_work.o \
lapacke_dsytrs_rook_work.o \
lapacke_dsytrs_aa.o \
+lapacke_dsytrs_aa_2stage.o \
lapacke_dsytrs_aa_work.o \
+lapacke_dsytrs_aa_2stage_work.o \
lapacke_dsytrs_3.o \
lapacke_dsytrs_3_work.o \
lapacke_dtbcon.o \
lapacke_dtrttp_work.o \
lapacke_dtzrzf.o \
lapacke_dtzrzf_work.o \
+lapacke_nancheck.o \
lapacke_sbbcsd.o \
lapacke_sbbcsd_work.o \
lapacke_sbdsdc.o \
lapacke_sgehrd_work.o \
lapacke_sgejsv.o \
lapacke_sgejsv_work.o \
+lapacke_sgelq.o \
+lapacke_sgelq_work.o \
lapacke_sgelq2.o \
lapacke_sgelq2_work.o \
lapacke_sgelqf.o \
lapacke_sgelss_work.o \
lapacke_sgelsy.o \
lapacke_sgelsy_work.o \
+lapacke_sgemlq.o \
+lapacke_sgemlq_work.o \
lapacke_sgemqr.o \
lapacke_sgemqr_work.o \
lapacke_sgemqrt.o \
lapacke_sgeqlf_work.o \
lapacke_sgeqp3.o \
lapacke_sgeqp3_work.o \
+lapacke_sgeqr.o \
+lapacke_sgeqr_work.o \
lapacke_sgeqr2.o \
lapacke_sgeqr2_work.o \
lapacke_sgeqrf.o \
lapacke_slaset_work.o \
lapacke_slasrt.o \
lapacke_slasrt_work.o \
+lapacke_slassq.o \
+lapacke_slassq_work.o \
lapacke_slaswp.o \
lapacke_slaswp_work.o \
lapacke_slauum.o \
lapacke_ssysv_work.o \
lapacke_ssysv_aa.o \
lapacke_ssysv_aa_work.o \
+lapacke_ssysv_aa_2stage.o \
+lapacke_ssysv_aa_2stage_work.o \
lapacke_ssysv_rk.o \
lapacke_ssysv_rk_work.o \
lapacke_ssysvx.o \
lapacke_ssytrf_rook_work.o \
lapacke_ssytrf_aa.o \
lapacke_ssytrf_aa_work.o \
+lapacke_ssytrf_aa_2stage.o \
+lapacke_ssytrf_aa_2stage_work.o \
lapacke_ssytrf_rk.o \
lapacke_ssytrf_rk_work.o \
lapacke_ssytri.o \
lapacke_ssytrs_work.o \
lapacke_ssytrs_rook_work.o \
lapacke_ssytrs_aa.o \
+lapacke_ssytrs_aa_2stage.o \
lapacke_ssytrs_aa_work.o \
+lapacke_ssytrs_aa_2stage_work.o \
lapacke_ssytrs_3.o \
lapacke_ssytrs_3_work.o \
lapacke_stbcon.o \
lapacke_zgehrd_work.o \
lapacke_zgejsv.o \
lapacke_zgejsv_work.o \
+lapacke_zgelq.o \
+lapacke_zgelq_work.o \
lapacke_zgelq2.o \
lapacke_zgelq2_work.o \
lapacke_zgelqf.o \
lapacke_zgelss_work.o \
lapacke_zgelsy.o \
lapacke_zgelsy_work.o \
+lapacke_zgemlq.o \
+lapacke_zgemlq_work.o \
lapacke_zgemqr.o \
lapacke_zgemqr_work.o \
lapacke_zgemqrt.o \
lapacke_zgeqlf_work.o \
lapacke_zgeqp3.o \
lapacke_zgeqp3_work.o \
+lapacke_zgeqr.o \
+lapacke_zgeqr_work.o \
lapacke_zgeqr2.o \
lapacke_zgeqr2_work.o \
lapacke_zgeqrf.o \
lapacke_zhesv_work.o \
lapacke_zhesv_aa.o \
lapacke_zhesv_aa_work.o \
+lapacke_zhesv_aa_2stage.o \
+lapacke_zhesv_aa_2stage_work.o \
lapacke_zhesv_rk.o \
lapacke_zhesv_rk_work.o \
lapacke_zhesvx.o \
lapacke_zhetrf_work.o \
lapacke_zhetrf_rook_work.o \
lapacke_zhetrf_aa.o \
+lapacke_zhetrf_aa_2stage.o \
lapacke_zhetrf_aa_work.o \
+lapacke_zhetrf_aa_2stage_work.o \
lapacke_zhetrf_rk.o \
lapacke_zhetrf_rk_work.o \
lapacke_zhetri.o \
lapacke_zhetrs_work.o \
lapacke_zhetrs_rook_work.o \
lapacke_zhetrs_aa.o \
+lapacke_zhetrs_aa_2stage.o \
lapacke_zhetrs_aa_work.o \
+lapacke_zhetrs_aa_2stage_work.o \
lapacke_zhetrs_3.o \
lapacke_zhetrs_3_work.o \
lapacke_zhfrk.o \
lapacke_zlacp2_work.o \
lapacke_zlacpy.o \
lapacke_zlacpy_work.o \
+lapacke_zlacrm.o \
+lapacke_zlacrm_work.o \
lapacke_zlag2c.o \
lapacke_zlag2c_work.o \
lapacke_zlange.o \
lapacke_zlapmr_work.o \
lapacke_zlapmt.o \
lapacke_zlapmt_work.o \
+lapacke_zlarcm.o \
+lapacke_zlarcm_work.o \
lapacke_zlarfb.o \
lapacke_zlarfb_work.o \
lapacke_zlarfg.o \
lapacke_zlascl_work.o \
lapacke_zlaset.o \
lapacke_zlaset_work.o \
+lapacke_zlassq.o \
+lapacke_zlassq_work.o \
lapacke_zlaswp.o \
lapacke_zlaswp_work.o \
lapacke_zlauum.o \
lapacke_zsysv_work.o \
lapacke_zsysv_aa.o \
lapacke_zsysv_aa_work.o \
+lapacke_zsysv_aa_2stage.o \
+lapacke_zsysv_aa_2stage_work.o \
lapacke_zsysv_rk.o \
lapacke_zsysv_rk_work.o \
lapacke_zsysvx.o \
lapacke_zsytrf_rook.o \
lapacke_zsytrf_rook_work.o \
lapacke_zsytrf_aa.o \
+lapacke_zsytrf_aa_2stage.o \
lapacke_zsytrf_aa_work.o \
+lapacke_zsytrf_aa_2stage_work.o \
lapacke_zsytrf_rk.o \
lapacke_zsytrf_rk_work.o \
lapacke_zsytri.o \
lapacke_zsytrs_work.o \
lapacke_zsytrs_rook_work.o \
lapacke_zsytrs_aa.o \
+lapacke_zsytrs_aa_2stage.o \
lapacke_zsytrs_aa_work.o \
+lapacke_zsytrs_aa_2stage_work.o \
lapacke_zsytrs_3.o \
lapacke_zsytrs_3_work.o \
lapacke_ztbcon.o \
lapacke_csyr_work.o \
lapacke_ilaver.o
-DEPRECSRC = \
+ifdef BUILD_DEPRECATED
+DEPRECATED = \
lapacke_cggsvp.o \
lapacke_cggsvp_work.o \
lapacke_dggsvp.o \
lapacke_sgeqpf_work.o \
lapacke_zgeqpf.o \
lapacke_zgeqpf_work.o
+endif
-SRCX_OBJ = \
+ifdef USEXBLAS
+EXTENDED = \
lapacke_cgbrfsx.o lapacke_cporfsx.o lapacke_dgerfsx.o lapacke_sgbrfsx.o lapacke_ssyrfsx.o lapacke_zherfsx.o \
lapacke_cgbrfsx_work.o lapacke_cporfsx_work.o lapacke_dgerfsx_work.o lapacke_sgbrfsx_work.o lapacke_ssyrfsx_work.o lapacke_zherfsx_work.o \
lapacke_cgerfsx.o lapacke_csyrfsx.o lapacke_dporfsx.o lapacke_sgerfsx.o lapacke_zgbrfsx.o lapacke_zporfsx.o \
lapacke_cgesvxx_work.o lapacke_csysvxx_work.o lapacke_dposvxx_work.o lapacke_sgesvxx_work.o lapacke_zgbsvxx_work.o lapacke_zposvxx_work.o \
lapacke_chesvxx.o lapacke_dgbsvxx.o lapacke_dsysvxx.o lapacke_sposvxx.o lapacke_zgesvxx.o lapacke_zsysvxx.o \
lapacke_chesvxx_work.o lapacke_dgbsvxx_work.o lapacke_dsysvxx_work.o lapacke_sposvxx_work.o lapacke_zgesvxx_work.o lapacke_zsysvxx_work.o
+endif
-
+ifdef LAPACKE_WITH_TMG
# FILE PARTS OF TMGLIB
-MATGEN_OBJ = \
+MATGEN = \
lapacke_clatms.o \
lapacke_clatms_work.o \
lapacke_dlatms.o \
lapacke_slagsy_work.o \
lapacke_zlagsy.o \
lapacke_zlagsy_work.o
-
-ALLOBJA = $(SRC_OBJA)
-ALLOBJB = $(SRC_OBJB) $(MATGEN_OBJ)
-
-ifdef USEXBLAS
-ALLXOBJ = $(SXLASRC) $(DXLASRC) $(CXLASRC) $(ZXLASRC)
-endif
-
-ifdef BUILD_DEPRECATED
-DEPRECATED = $(DEPRECSRC)
endif
all: ../../$(LAPACKELIB)
-../../$(LAPACKELIB): $(ALLOBJA) $(ALLOBJB) $(ALLXOBJ) $(DEPRECATED)
- $(ARCH) $(ARCHFLAGS) $@ $(ALLOBJA)
- $(ARCH) $(ARCHFLAGS) $@ $(ALLOBJB) $(ALLXOBJ) $(DEPRECATED)
+../../$(LAPACKELIB): $(OBJ_A) $(OBJ_B) $(DEPRECATED) $(EXTENDED) $(MATGEN)
+ $(ARCH) $(ARCHFLAGS) $@ $(OBJ_A)
+ $(ARCH) $(ARCHFLAGS) $@ $(OBJ_B)
+ $(ARCH) $(ARCHFLAGS) $@ $(DEPRECATED)
+ $(ARCH) $(ARCHFLAGS) $@ $(EXTENDED)
+ $(ARCH) $(ARCHFLAGS) $@ $(MATGEN)
$(RANLIB) $@
+clean: cleanobj
+cleanobj:
+ rm -f *.o
+
.c.o:
$(CC) $(CFLAGS) -I../include -c -o $@ $<
-
-clean:
- rm -f *.o
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cbbcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lrwork = -1;
float* rwork = NULL;
float rwork_query;
- lapack_int nrows_u1, nrows_u2, nrows_v1t, nrows_v2t;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cbbcsd", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- if( LAPACKE_s_nancheck( q-1, phi, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( q, theta, 1 ) ) {
- return -10;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_u1, p, u1, ldu1 ) ) {
- return -12;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( q-1, phi, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_u2, m-p, u2, ldu2 ) ) {
- return -14;
+ if( LAPACKE_s_nancheck( q, theta, 1 ) ) {
+ return -10;
}
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v1t, q, v1t, ldv1t ) ) {
- return -16;
+ if( LAPACKE_lsame( jobu1, 'y' ) ) {
+ if( LAPACKE_cge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) {
+ return -12;
+ }
}
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v2t, m-q, v2t, ldv2t ) ) {
- return -18;
+ if( LAPACKE_lsame( jobu2, 'y' ) ) {
+ if( LAPACKE_cge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_lsame( jobv1t, 'y' ) ) {
+ if( LAPACKE_cge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) {
+ return -16;
+ }
+ }
+ if( LAPACKE_lsame( jobv2t, 'y' ) ) {
+ if( LAPACKE_cge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) {
+ return -18;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function cbbcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lrwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
+ }
/* Call LAPACK function and adjust info */
- LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
+ LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, <rans, &m, &p, &q,
theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
&ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e,
rwork, &lrwork, &info );
if( info < 0 ) {
info = info - 1;
}
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- lapack_complex_float* u1_t = NULL;
- lapack_complex_float* u2_t = NULL;
- lapack_complex_float* v1t_t = NULL;
- lapack_complex_float* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lrwork == -1 ) {
- LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
- v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e,
- b22d, b22e, rwork, &lrwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_cge_trans( matrix_layout, nrows_u1, p, u1, ldu1, u1_t,
- ldu1_t );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_cge_trans( matrix_layout, nrows_u2, m-p, u2, ldu2, u2_t,
- ldu2_t );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_cge_trans( matrix_layout, nrows_v1t, q, v1t, ldv1t, v1t_t,
- ldv1t_t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_cge_trans( matrix_layout, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
- ldv2t_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
- &ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
- b21e, b22d, b22e, rwork, &lrwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( ncc != 0 ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, ncc, c, ldc ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( ncc != 0 ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, ncc, c, ldc ) ) {
+ return -13;
+ }
}
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -8;
- }
- if( nru != 0 ) {
- if( LAPACKE_cge_nancheck( matrix_layout, nru, n, u, ldu ) ) {
- return -11;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -7;
}
- }
- if( ncvt != 0 ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -8;
+ }
+ if( nru != 0 ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, nru, n, u, ldu ) ) {
+ return -11;
+ }
+ }
+ if( ncvt != 0 ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( ncc != 0 ) {
- if( LAPACKE_cge_nancheck( matrix_layout, m, ncc, c, ldc ) ) {
- return -16;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -8;
+ }
+ if( ncc != 0 ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, m, ncc, c, ldc ) ) {
+ return -16;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_cgbequ_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_cgbequb_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -9;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
+ return -9;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -25;
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
+ return -10;
}
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -13;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -14;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -25;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -17;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -17;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_cgbsv_work( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -15;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
+ ldafb ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -14;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -16;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -15;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -14;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -15;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
+ ldafb ) ) {
+ return -10;
+ }
}
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -27;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -16;
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -14;
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -15;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -27;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -14;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_cgbtrf_work( matrix_layout, m, n, kl, ku, ab, ldab, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_cgbtrs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, scale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, m, v, ldv ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, scale, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, m, v, ldv ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_cgebak_work( matrix_layout, job, side, n, ilo, ihi, scale, m,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
+ LAPACKE_lsame( job, 's' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cgeequ_work( matrix_layout, m, n, a, lda, r, c, rowcnd,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cgeequb_work( matrix_layout, m, n, a, lda, r, c, rowcnd,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
{
lapack_int info = 0;
lapack_int lwork = (
- // 1.1
- ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
+ // 1.1
+ ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? 2*n+1 :
//1.2
- ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
+ ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
!( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? n*n+3*n :
//2.1
- ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
- !( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
+ ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
+ !( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) )&&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n :
//2.2
- ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
+ ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
!( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
!( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n :
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 4*n*n:
1) ) ) ) ) ) ) );
lapack_int lrwork = (
- // 1.1
- ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
+ // 1.1
+ ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,n+2*m) :
//1.2
!( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,2*n) :
//2.1
- ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
- !( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
+ ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
+ !( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) ) &&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX( 7, n+ 2*m ) :
//2.2
- ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
+ ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
!( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
!( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) :
( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) :
- 7 ))))))));
+ 7) ) ) ) ) ) ) );
lapack_int* iwork = NULL;
float* rwork = NULL;
lapack_complex_float* cwork = NULL;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
- nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
+ nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cgelq
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
-lapack_int LAPACKE_cgelq_work( int matrix_layout, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* t, lapack_int tsize )
+lapack_int LAPACKE_cgelq( int matrix_layout, lapack_int m, lapack_int n,
+ lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* t, lapack_int tsize )
{
lapack_int info = 0;
lapack_int lwork = -1;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cgemlq
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( tsize, t, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_c_nancheck( tsize, t, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_c_nancheck( tsize, t, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_c_nancheck( tsize, t, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -12;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -12;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cgeqr
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cgeqrt2_work( matrix_layout, m, n, a, lda, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cgeqrt3_work( matrix_layout, m, n, a, lda, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -23;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -11;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -12;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -23;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -15;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -15;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cgesdd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
if( LAPACKE_lsame( jobz, 'n' ) ) {
lrwork = MAX(1,7*MIN(m,n));
} else {
- lrwork = (size_t)MIN(m,n)*MAX(5*MIN(m,n)+7,2*MAX(m,n)+2*MIN(m,n)+1);
+ lrwork = (size_t)MAX(1,MIN(m,n)*MAX(5*MIN(m,n)+7,2*MAX(m,n)+2*MIN(m,n)+1));
}
/* Allocate memory for working array(s) */
iwork = (lapack_int*)
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_cgesv_work( matrix_layout, n, nrhs, a, lda, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
info = LAPACKE_cgesvdx_work( matrix_layout, jobu, jobvt, range,
- m, n, a, lda, vl, vu, il, iu, ns, s, u,
+ m, n, a, lda, vl, vu, il, iu, ns, s, u,
ldu, vt, ldvt, &work_query, lwork, rwork, iwork );
if( info != 0 ) {
goto exit_level_0;
lwork = LAPACK_C2INT (work_query);
/* Allocate memory for work arrays */
work = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
+ LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Call middle-level interface */
info = LAPACKE_cgesvdx_work( matrix_layout, jobu, jobvt, range,
- m, n, a, lda, vl, vu, il, iu, ns, s, u,
- ldu, vt, ldvt, work, lwork, rwork, iwork );
+ m, n, a, lda, vl, vu, il, iu, ns, s, u,
+ ldu, vt, ldvt, work, lwork, rwork, iwork );
/* Backup significant data from working array(s) */
for( i=0; i<12*MIN(m,n)-1; i++ ) {
superb[i] = iwork[i+1];
#include "lapacke_utils.h"
lapack_int LAPACKE_cgesvdx_work( int matrix_layout, char jobu, char jobvt, char range,
- lapack_int m, lapack_int n, lapack_complex_float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- float* s, lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* vt, lapack_int ldvt,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int* iwork )
+ lapack_int m, lapack_int n, lapack_complex_float* a,
+ lapack_int lda, float vl, float vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ float* s, lapack_complex_float* u, lapack_int ldu,
+ lapack_complex_float* vt, lapack_int ldvt,
+ lapack_complex_float* work, lapack_int lwork,
+ float* rwork, lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_cgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda, &vl, &vu,
- &il, &iu, ns, s, u, &ldu, vt, &ldvt,
+ &il, &iu, ns, s, u, &ldu, vt, &ldvt,
work, &lwork, rwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_cgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu,
- &il, &iu, ns, s, u, &ldu_t, vt,
+ &il, &iu, ns, s, u, &ldu_t, vt,
&ldvt_t, work, &lwork, rwork, iwork, &info );
return (info < 0) ? (info - 1) : info;
}
LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_cgesvdx( &jobu, &jobvt, &range, &m, &n, a_t, &lda_t, &vl, &vu,
- &il, &iu, ns, s, u_t, &ldu_t, vt_t,
- &ldvt_t, work, &lwork, rwork, iwork, &info );
+ &il, &iu, ns, s, u_t, &ldu_t, vt_t,
+ &ldvt_t, work, &lwork, rwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) :
- ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0);
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, n, v, ldv ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) :
+ ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0);
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, n, v, ldv ) ) {
+ return -11;
+ }
}
}
#endif
}
if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
v_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,n) );
+ LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,n) );
if( v_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -13;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -12;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -13;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -25;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -13;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -25;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cgetf2_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cgetrf_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cgetrf2_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_cgetrs_work( matrix_layout, trans, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, lscale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n, rscale, 1 ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, m, v, ldv ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, lscale, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( n, rscale, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, m, v, ldv ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_cggbak_work( matrix_layout, job, side, n, ilo, ihi, lscale,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
+ LAPACKE_lsame( job, 'b' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -6;
+ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
+ LAPACKE_lsame( job, 'b' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, p, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_c_nancheck( n, d, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, m, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, p, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_c_nancheck( n, d, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -13;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -13;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -13;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -13;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_c_nancheck( m, c, 1 ) ) {
- return -9;
- }
- if( LAPACKE_c_nancheck( p, d, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_c_nancheck( m, c, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_c_nancheck( p, d, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, p, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, m, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, p, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
{
lapack_int info = 0;
float* rwork = NULL;
- lapack_int lwork = -1;
+ lapack_int lwork = -1;
lapack_complex_float* work = NULL;
lapack_complex_float work_query;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
+ }
}
#endif
/* Query optimal size for working array */
info = LAPACKE_cggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l,
a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q,
ldq, &work_query, lwork, rwork, iwork );
- if( info != 0 )
- goto exit_level_0;
- lwork = LAPACK_C2INT( work_query );
+ if( info != 0 )
+ goto exit_level_0;
+ lwork = LAPACK_C2INT( work_query );
/* Allocate memory for working array(s) */
rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) );
if( rwork == NULL ) {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
+ return -13;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
+ return -13;
+ }
}
#endif
/* Query optimal size for working array */
lapack_int info = 0;
lapack_complex_float* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -8;
- }
- if( LAPACKE_c_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
- return -3;
- }
- if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_c_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_c_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_c_nancheck( n, df, 1 ) ) {
- return -9;
- }
- if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n-1, dlf, 1 ) ) {
- return -8;
- }
- if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) {
- return -11;
- }
- if( LAPACKE_c_nancheck( n-1, duf, 1 ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -15;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_c_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_c_nancheck( n, df, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( n-1, dlf, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) {
+ return -11;
+ }
+ if( LAPACKE_c_nancheck( n-1, duf, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -15;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_c_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_c_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_cgtsv_work( matrix_layout, n, nrhs, dl, d, du, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_c_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_c_nancheck( n, df, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
}
- }
- if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_c_nancheck( n-1, dlf, 1 ) ) {
- return -9;
+ if( LAPACKE_c_nancheck( n, d, 1 ) ) {
+ return -7;
}
- }
- if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_c_nancheck( n, df, 1 ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_c_nancheck( n-1, duf, 1 ) ) {
- return -11;
+ if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_c_nancheck( n-1, dlf, 1 ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) {
+ return -12;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_c_nancheck( n-1, duf, 1 ) ) {
+ return -11;
+ }
}
}
#endif
lapack_complex_float* du2, lapack_int* ipiv )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_c_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
- return -2;
- }
- if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_c_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cgttrf_work( n, dl, d, du, du2, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_c_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_c_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( n-1, du, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_cgttrs_work( matrix_layout, trans, n, nrhs, dl, d, du, du2,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function chbev_2stage
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_chbev_2stage( &jobz, &uplo, &n, &kd, ab, &ldab, w, z, &ldz, work, &lwork,
- rwork, &info );
+ rwork, &info );
if( info < 0 ) {
info = info - 1;
}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -18;
- }
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -15;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -18;
+ }
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -15;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_lsame( vect, 'u' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( vect, 'u' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function checon_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
{
lapack_int info = 0;
lapack_complex_float* work = NULL;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_checon_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function cheevr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
+ lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 :
+ ( LAPACKE_lsame( range, 'a' ) ||
+ LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int lda_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function cheevx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
+ lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 :
+ ( LAPACKE_lsame( range, 'a' ) ||
+ LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int lda_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_chegst_work( matrix_layout, itype, uplo, n, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function chegvx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function chesv_aa_2stage
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_chesv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ lapack_complex_float* work = NULL;
+ lapack_complex_float work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_chesv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = LAPACK_C2INT( work_query );
+ /* Allocate memory for work arrays */
+ work = (lapack_complex_float*)
+ LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_chesv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function chesv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_chesv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb,
+ lapack_complex_float* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_chesv_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_float* a_t = NULL;
+ lapack_complex_float* tb_t = NULL;
+ lapack_complex_float* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_chesv_aa_2stage( &uplo, &n, &nrhs, a, &lda_t,
+ tb, <b, ipiv, ipiv2, b, &ldb_t, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_chesv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function chesv_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n, e, 1) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -24;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -24;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cheswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function chetrf_aa_2stage
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_chetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ lapack_complex_float* work = NULL;
+ lapack_complex_float work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_chetrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = LAPACK_C2INT( work_query );
+ /* Allocate memory for work arrays */
+ work = (lapack_complex_float*)
+ LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_chetrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function chetrf_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_chetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_chetrf_aa_2stage( &uplo, &n, a, &lda, tb,
+ <b, ipiv, ipiv2, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_complex_float* a_t = NULL;
+ lapack_complex_float* tb_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_chetrf_aa_2stage( &uplo, &n, a, &lda_t,
+ tb, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ /* Transpose input matrices */
+ LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_chetrf_aa_2stage( &uplo, &n, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ /* Release memory and exit */
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function chetrf_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function chetrf_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int LAPACKE_chetrf_rk_work( int matrix_layout, char uplo, lapack_int n,
lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* e,
+ lapack_complex_float* e,
lapack_int* ipiv, lapack_complex_float* work,
lapack_int lwork )
{
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function chetri_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
lapack_complex_float* work = NULL;
lapack_complex_float work_query;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_chetri_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_chetrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function chetrs_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n, e ,1 ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( n, e ,1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_chetrs_3_work( matrix_layout, uplo, n, nrhs, a, lda,
- e, ipiv, b, ldb );
+ e, ipiv, b, ldb );
}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function chetrs_aa_2stage
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_chetrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a,
+ lapack_int lda, lapack_complex_float* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Call middle-level interface */
+ info = LAPACKE_chetrs_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb );
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function chetrs_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_chetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_chetrs_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_float* a_t = NULL;
+ lapack_complex_float* tb_t = NULL;
+ lapack_complex_float* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_chetrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info );
+ }
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_chetrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
- na = LAPACKE_lsame( trans, 'n' ) ? n : k;
- if( LAPACKE_cge_nancheck( matrix_layout, na, ka, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) {
- return -10;
- }
- if( LAPACKE_cpf_nancheck( n, c ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
+ na = LAPACKE_lsame( trans, 'n' ) ? n : k;
+ if( LAPACKE_cge_nancheck( matrix_layout, na, ka, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_cpf_nancheck( n, c ) ) {
+ return -11;
+ }
}
#endif
return LAPACKE_chfrk_work( matrix_layout, transr, uplo, trans, n, k, alpha,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -8;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -8;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -16;
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -16;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_chp_nancheck( n, bp ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_chp_nancheck( n, bp ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_chpgst_work( matrix_layout, itype, uplo, n, ap, bp );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_chp_nancheck( n, bp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_chp_nancheck( n, bp ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_chp_nancheck( n, bp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_chp_nancheck( n, bp ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -13;
- }
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -7;
- }
- if( LAPACKE_chp_nancheck( n, bp ) ) {
- return -8;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -13;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -10;
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_chp_nancheck( n, bp ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_chpsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_chp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_chp_nancheck( n, afp ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_chptrd_work( matrix_layout, uplo, n, ap, d, e, tau );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_chptrf_work( matrix_layout, uplo, n, ap, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_chp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_chp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_chptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
+ }
+ if( LAPACKE_c_nancheck( n, w, 1 ) ) {
+ return -9;
}
- }
- if( LAPACKE_c_nancheck( n, w, 1 ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -7;
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -10;
+ }
}
}
#endif
lapack_int incx )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_c_nancheck( 1+(n-1)*ABS(incx), x, incx ) ) {
- return -2;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_c_nancheck( 1+(n-1)*ABS(incx), x, incx ) ) {
+ return -2;
+ }
}
#endif
return LAPACKE_clacgv_work( n, x, incx );
float* est, lapack_int* kase, lapack_int* isave )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, est, 1 ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n, x, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, est, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( n, x, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_clacn2_work( n, v, x, est, kase, isave );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_clacp2_work( matrix_layout, uplo, m, n, a, lda, b, ldb );
* Generated January, 2013
*****************************************************************************/
-#include "lapacke.h"
#include "lapacke_utils.h"
lapack_int LAPACKE_clacp2_work( int matrix_layout, char uplo, lapack_int m,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_clacpy_work( matrix_layout, uplo, m, n, a, lda, b, ldb );
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function clacrm
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_clacrm(int matrix_layout, lapack_int m,
+ lapack_int n, const lapack_complex_float* a,
+ lapack_int lda, const float* b, lapack_int ldb,
+ lapack_complex_float* c, lapack_int ldc)
+{
+ lapack_int info = 0;
+ float* rwork = NULL;
+
+ if (matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR) {
+ LAPACKE_xerbla("LAPACKE_clacrm", -1);
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if ( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -6;
+ }
+ }
+#endif
+ /* Allocate memory for work array(s) */
+ rwork = (float*)
+ LAPACKE_malloc(sizeof(float) * MAX(1, 2 * m * n));
+ if (rwork == NULL) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_clacrm_work(matrix_layout, m, n, a, lda, b, ldb,
+ c, ldc, rwork);
+ /* Release memory and exit */
+ LAPACKE_free(rwork);
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_clacrm", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function clacrm
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_clacrm_work(int matrix_layout, lapack_int m, lapack_int n,
+ const lapack_complex_float* a, lapack_int lda,
+ const float* b, lapack_int ldb,
+ lapack_complex_float* c, lapack_int ldc,
+ float* rwork)
+{
+ lapack_int info = 0;
+ if (matrix_layout == LAPACK_COL_MAJOR) {
+ /* Call LAPACK function */
+ LAPACK_clacrm(&m, &n, a, &lda, b, &ldb, c, &ldc, rwork);
+ } else if (matrix_layout == LAPACK_ROW_MAJOR) {
+ lapack_int lda_t = MAX(1,m);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_int ldc_t = MAX(1,m);
+ lapack_complex_float* a_t = NULL;
+ float* b_t = NULL;
+ lapack_complex_float* c_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -5;
+ LAPACKE_xerbla( "LAPACKE_clacrm_work", info );
+ return info;
+ }
+ if( ldb < n ) {
+ info = -7;
+ LAPACKE_xerbla( "LAPACKE_clacrm_work", info );
+ return info;
+ }
+ if( ldc < n ) {
+ info = -9;
+ LAPACKE_xerbla( "LAPACKE_clacrm_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_float*)
+ LAPACKE_malloc(sizeof(lapack_complex_float) * lda_t * MAX(1,n));
+ b_t = (float*)
+ LAPACKE_malloc(sizeof(float) * ldb_t * MAX(1,n));
+ c_t = (lapack_complex_float*)
+ LAPACKE_malloc((sizeof(lapack_complex_float) * ldc_t * MAX(1,n)));
+ if (a_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ if (b_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ if (c_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_cge_trans(matrix_layout, m, n, a, lda, a_t, lda_t);
+ LAPACKE_sge_trans(matrix_layout, n, n, b, ldb, b_t, ldb_t);
+ /* Call LAPACK function */
+ LAPACK_clacrm(&m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, rwork);
+ /* Transpose output matrices */
+ LAPACKE_cge_trans(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc);
+ /* Release memory and exit */
+ LAPACKE_free(c_t);
+exit_level_2:
+ LAPACKE_free(b_t);
+exit_level_1:
+ LAPACKE_free(a_t);
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_clacrm_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla("LAPACKE_clacrm_work", -1);
+ }
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, sa, ldsa ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, sa, ldsa ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_clag2z_work( matrix_layout, m, n, sa, ldsa, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function clange
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
{
lapack_int info = 0;
float res = 0.;
+ char norm_lapack;
if( matrix_layout == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
+ /* Call LAPACK function */
res = LAPACK_clange( &norm, &m, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_complex_float* a_t = NULL;
+ float* work_lapack = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_clange_work", info );
return info;
}
- /* Allocate memory for temporary array(s) */
- a_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
+ if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
+ norm_lapack = 'i';
+ } else if( LAPACKE_lsame( norm, 'i' ) ) {
+ norm_lapack = '1';
+ } else {
+ norm_lapack = norm;
+ }
+ /* Allocate memory for work array(s) */
+ if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
+ work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
+ if( work_lapack == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
}
- /* Transpose input matrices */
- LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_clange( &norm, &m, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
+ /* Call LAPACK function */
+ res = LAPACK_clange( &norm_lapack, &n, &m, a, &lda, work_lapack );
/* Release memory and exit */
- LAPACKE_free( a_t );
+ if( work_lapack ) {
+ LAPACKE_free( work_lapack );
+ }
exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_clange_work", info );
}
} else {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_clapmr_work( matrix_layout, forwrd, m, n, x, ldx, k );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_clapmt_work( matrix_layout, forwrd, m, n, x, ldx, k );
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function clarcm
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_clarcm(int matrix_layout, lapack_int m,
+ lapack_int n, const float* a, lapack_int lda,
+ const lapack_complex_float* b, lapack_int ldb,
+ lapack_complex_float* c, lapack_int ldc)
+{
+ lapack_int info = 0;
+ float* rwork = NULL;
+
+ if (matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR) {
+ LAPACKE_xerbla("LAPACKE_clarcm", -1);
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if ( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -6;
+ }
+ }
+#endif
+ /* Allocate memory for work array(s) */
+ rwork = (float*)
+ LAPACKE_malloc(sizeof(float) * MAX(1, 2 * m * n));
+ if (rwork == NULL) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_clarcm_work(matrix_layout, m, n, a, lda, b, ldb,
+ c, ldc, rwork);
+ /* Release memory and exit */
+ LAPACKE_free(rwork);
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_clarcm", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function clarcm
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_clarcm_work(int matrix_layout, lapack_int m, lapack_int n,
+ const float* a, lapack_int lda,
+ const lapack_complex_float* b, lapack_int ldb,
+ lapack_complex_float* c, lapack_int ldc,
+ float* rwork)
+{
+ lapack_int info = 0;
+ if (matrix_layout == LAPACK_COL_MAJOR) {
+ /* Call LAPACK function */
+ LAPACK_clarcm(&m, &n, a, &lda, b, &ldb, c, &ldc, rwork);
+ } else if (matrix_layout == LAPACK_ROW_MAJOR) {
+ lapack_int lda_t = MAX(1,m);
+ lapack_int ldb_t = MAX(1,m);
+ lapack_int ldc_t = MAX(1,m);
+ float* a_t = NULL;
+ lapack_complex_float* b_t = NULL;
+ lapack_complex_float* c_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < m ) {
+ info = -5;
+ LAPACKE_xerbla( "LAPACKE_clarcm_work", info );
+ return info;
+ }
+ if( ldb < n ) {
+ info = -7;
+ LAPACKE_xerbla( "LAPACKE_clarcm_work", info );
+ return info;
+ }
+ if( ldc < n ) {
+ info = -9;
+ LAPACKE_xerbla( "LAPACKE_clarcm_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (float*)
+ LAPACKE_malloc(sizeof(float) * lda_t * MAX(1,m));
+ b_t = (lapack_complex_float*)
+ LAPACKE_malloc(sizeof(lapack_complex_float) * ldb_t * MAX(1,n));
+ c_t = (lapack_complex_float*)
+ LAPACKE_malloc((sizeof(lapack_complex_float) * ldc_t * MAX(1,n)));
+ if (a_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ if (b_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ if (c_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_sge_trans(matrix_layout, m, m, a, lda, a_t, lda_t);
+ LAPACKE_cge_trans(matrix_layout, m, n, b, ldb, b_t, ldb_t);
+ /* Call LAPACK function */
+ LAPACK_clarcm(&m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, rwork);
+ /* Transpose output matrices */
+ LAPACKE_cge_trans(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc);
+ /* Release memory and exit */
+ LAPACKE_free(c_t);
+exit_level_2:
+ LAPACKE_free(b_t);
+exit_level_1:
+ LAPACKE_free(a_t);
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_clarcm_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla("LAPACKE_clarcm_work", -1);
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function clarfb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int ldc )
{
lapack_int info = 0;
- lapack_int ldwork = ( side=='l')?n:(( side=='r')?m:1);
+ lapack_int ldwork;
lapack_complex_float* work = NULL;
lapack_int ncols_v, nrows_v;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
- nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -13;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
- if( k > nrows_v ) {
- LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
+ ( ( LAPACKE_lsame( storev, 'r' ) &&
+ LAPACKE_lsame( side, 'l' ) ) ? m :
+ ( ( LAPACKE_lsame( storev, 'r' ) &&
+ LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+ nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
+ LAPACKE_lsame( side, 'l' ) ) ? m :
+ ( ( LAPACKE_lsame( storev, 'c' ) &&
+ LAPACKE_lsame( side, 'r' ) ) ? n :
+ ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -13;
}
- if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k,
- &v[(nrows_v-k)*ldv], ldv ) )
- return -9;
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( k > ncols_v ) {
- LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
- return -8;
+ if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) {
+ return -11;
+ }
+ if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
+ return -9;
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
+ ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
+ if( k > nrows_v ) {
+ LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
+ return -8;
+ }
+ if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k,
+ &v[(nrows_v-k)*ldv], ldv ) )
+ return -9;
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
+ return -9;
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
+ ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( k > ncols_v ) {
+ LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
+ return -8;
+ }
+ if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
+ ldv ) )
+ return -9;
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
+ return -9;
}
- if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
- ldv ) )
- return -9;
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
- return -9;
}
#endif
+ if( LAPACKE_lsame( side, 'l' ) ) {
+ ldwork = n;
+ } else if( LAPACKE_lsame( side, 'r' ) ) {
+ ldwork = m;
+ } else {
+ ldwork = 1;
+ }
/* Allocate memory for working array(s) */
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * ldwork * MAX(1,k) );
lapack_complex_float* tau )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_c_nancheck( 1, alpha, 1 ) ) {
- return -2;
- }
- if( LAPACKE_c_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_c_nancheck( 1, alpha, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_c_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_clarfg_work( n, alpha, x, incx, tau );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
- nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
+ ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
+ nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
+ ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_clarft_work( matrix_layout, direct, storev, n, k, v, ldv, tau,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -7;
- }
- if( LAPACKE_c_nancheck( 1, &tau, 1 ) ) {
- return -6;
- }
- if( LAPACKE_c_nancheck( m, v, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -7;
+ }
+ if( LAPACKE_c_nancheck( 1, &tau, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_c_nancheck( m, v, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_clarfx_work( matrix_layout, side, m, n, v, tau, c, ldc,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- switch (type) {
- case 'G':
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ switch (type) {
+ case 'G':
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'L':
+ // TYPE = 'L' - lower triangle of general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_cgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
+ return -9;
+ }
+ break;
+ case 'U':
+ // TYPE = 'U' - upper triangle of general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_cgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
+ return -9;
+ }
+ break;
+ case 'H':
+ // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_cgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
+ return -9;
+ }
+ case 'B':
+ // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
+ if( LAPACKE_chb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'Q':
+ // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
+ if( LAPACKE_chb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'Z':
+ // TYPE = 'Z' - band matrix laid out for ?GBTRF
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
+ return -9;
+ }
+ break;
}
- break;
- case 'L':
- // TYPE = 'L' - lower triangle of general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_cgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
- return -9;
- }
- break;
- case 'U':
- // TYPE = 'U' - upper triangle of general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_cgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
- return -9;
- }
- break;
- case 'H':
- // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_cgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
- return -9;
- }
- case 'B':
- // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
- if( LAPACKE_chb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
- return -9;
- }
- break;
- case 'Q':
- // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
- if( LAPACKE_chb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
- return -9;
- }
- break;
- case 'Z':
- // TYPE = 'Z' - band matrix laid out for ?GBTRF
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
- return -9;
- }
- break;
}
#endif
return LAPACKE_clascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda );
*****************************************************************************/
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_c_nancheck( 1, &alpha, 1 ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( 1, &beta, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_c_nancheck( 1, &alpha, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( 1, &beta, 1 ) ) {
+ return -6;
+ }
}
#endif
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function classq
+* Author: Julien Langou
+* Generated February, 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_classq( lapack_int n, lapack_complex_float* x,
+ lapack_int incx, float* scale, float* sumsq )
+{
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input vector `x` and in/out scalars `scale` and `sumsq` for NaNs */
+ if( LAPACKE_c_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
+ return -2;
+ }
+ if( LAPACKE_s_nancheck( 1, scale, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, sumsq, 1 ) ) {
+ return -5;
+ }
+ }
+#endif
+ return LAPACKE_classq_work( n, x, incx, scale, sumsq );
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function classq
+* Author: Julien Langou
+* Generated February, 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_classq_work( lapack_int n, lapack_complex_float* x, lapack_int incx, float* scale, float* sumsq )
+{
+ lapack_int info = 0;
+ LAPACK_classq( &n, x, &incx, scale, sumsq );
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
-/*****************************************************************************
-* Disable the check as is below, the check below was checking for NaN
-* from lda to n since there is no (obvious) way to knowing m. This is not
-* a good idea. We could get a lower bound of m by scanning from ipiv. Or
-* we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable
-* the buggy Nan check.
-* See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827
-*****************************************************************************/
-/* if( LAPACKE_cge_nancheck( matrix_layout, lda, n, a, lda ) ) {
-* return -3;
-* }
-*/
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ /*****************************************************************************
+ * Disable the check as is below, the check below was checking for NaN
+ * from lda to n since there is no (obvious) way to knowing m. This is not
+ * a good idea. We could get a lower bound of m by scanning from ipiv. Or
+ * we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable
+ * the buggy Nan check.
+ * See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827
+ *****************************************************************************/
+ /* if( LAPACKE_cge_nancheck( matrix_layout, lda, n, a, lda ) ) {
+ * return -3;
+ * }
+ */
+ }
#endif
return LAPACKE_claswp_work( matrix_layout, n, a, lda, k1, k2, ipiv, incx );
}
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function claswp
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_s_nancheck( 1, &cond, 1 ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( MIN(n,m), d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &dmax, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -14;
+ }
+ if( LAPACKE_s_nancheck( 1, &cond, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_s_nancheck( MIN(n,m), d, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &dmax, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_clauum_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_cpbequ_work( matrix_layout, uplo, n, kd, ab, ldab, s, scond,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_cpbstf_work( matrix_layout, uplo, n, kb, bb, ldbb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_cpbsv_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_cpbtrf_work( matrix_layout, uplo, n, kd, ab, ldab );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_cpbtrs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpf_nancheck( n, a ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpf_nancheck( n, a ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_cpftrf_work( matrix_layout, transr, uplo, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpf_nancheck( n, a ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpf_nancheck( n, a ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_cpftri_work( matrix_layout, transr, uplo, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpf_nancheck( n, a ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpf_nancheck( n, a ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_cpftrs_work( matrix_layout, transr, uplo, n, nrhs, a, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_cpoequ_work( matrix_layout, n, a, lda, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_cpoequb_work( matrix_layout, n, a, lda, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -21;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -10;
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -21;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -13;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -13;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_cposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -23;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -23;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cpotrf_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cpotrf2_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cpotri_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_cpotrs_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -5;
- }
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cppequ_work( matrix_layout, uplo, n, ap, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_cppsv_work( matrix_layout, uplo, n, nrhs, ap, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_cpp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_cpp_nancheck( n, afp ) ) {
+ return -7;
+ }
}
- }
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -9;
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cpptrf_work( matrix_layout, uplo, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_cpptri_work( matrix_layout, uplo, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_cpptrs_work( matrix_layout, uplo, n, nrhs, ap, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &tol, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, &tol, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
lapack_int info = 0;
float* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -7;
- }
- if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_c_nancheck( n-1, ef, 1 ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n, df, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_c_nancheck( n-1, ef, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_cptsv_work( matrix_layout, n, nrhs, d, e, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_c_nancheck( n-1, ef, 1 ) ) {
- return -8;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n, df, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_c_nancheck( n-1, ef, 1 ) ) {
+ return -8;
+ }
}
}
#endif
lapack_int LAPACKE_cpttrf( lapack_int n, float* d, lapack_complex_float* e )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_cpttrf_work( n, d, e );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_cpttrs_work( matrix_layout, uplo, n, nrhs, d, e, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
- if( LAPACKE_csp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_csp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_csp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_csp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_cspsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_csp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_csp_nancheck( n, afp ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_csp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_csp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_csptrf_work( matrix_layout, uplo, n, ap, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_csptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cstegr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cstein
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, w, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n, w, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function cstemr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int ldz_t = MAX(1,n);
lapack_complex_float* z_t = NULL;
/* Check leading dimension(s) */
- if( ldz < n ) {
+ if( ldz < 1 || ( LAPACKE_lsame( jobz, 'v' ) && ldz < n ) ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_cstemr_work", info );
return info;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function csycon_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
{
lapack_int info = 0;
lapack_complex_float* work = NULL;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_csycon_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function csycon_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int LAPACKE_csycon_3_work( int matrix_layout, char uplo, lapack_int n,
const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* e,
+ const lapack_complex_float* e,
const lapack_int* ipiv, float anorm,
float* rcond, lapack_complex_float* work )
{
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Call middle-level interface */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_c_nancheck( 1, &alpha, 1 ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n, x, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_c_nancheck( 1, &alpha, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n, x, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_csyr_work( matrix_layout, uplo, n, alpha, x, incx, a,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function csysv_aa
* Author: Intel Corporation
-* Generated December 2016
+* Generated November 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally csyck input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function csysv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csysv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ lapack_complex_float* work = NULL;
+ lapack_complex_float work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_csysv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = LAPACK_C2INT( work_query );
+ /* Allocate memory for work arrays */
+ work = (lapack_complex_float*)
+ LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_csysv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function csysv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb,
+ lapack_complex_float* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_csysv_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_float* a_t = NULL;
+ lapack_complex_float* tb_t = NULL;
+ lapack_complex_float* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_csysv_aa_2stage( &uplo, &n, &nrhs, a, &lda_t,
+ tb, <b, ipiv, ipiv2, b, &ldb_t, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_csysv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function csysv_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n, e, 1) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -24;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -24;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_csyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally csyck input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally csyck input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function csytrf_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2 )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ lapack_complex_float* work = NULL;
+ lapack_complex_float work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_csytrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = LAPACK_C2INT( work_query );
+ /* Allocate memory for work arrays */
+ work = (lapack_complex_float*)
+ LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_csytrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function csytrf_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_float* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_csytrf_aa_2stage( &uplo, &n, a, &lda, tb,
+ <b, ipiv, ipiv2, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_complex_float* a_t = NULL;
+ lapack_complex_float* tb_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage_work", info );
+ return info;
+ }
+
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_csytrf_aa_2stage( &uplo, &n, a, &lda_t,
+ tb, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ /* Transpose input matrices */
+ LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_csytrf_aa_2stage( &uplo, &n, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ /* Release memory and exit */
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function csytrf_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function csytri_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
lapack_complex_float* work = NULL;
lapack_complex_float work_query;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_csytri_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_csytrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n, e ,1 ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( n, e ,1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_csytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally csyck input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally csyck input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function csytrs_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Call middle-level interface */
+ info = LAPACKE_csytrs_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb );
+
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function csytrs_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_csytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_float* a, lapack_int lda,
+ lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_csytrs_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_float* a_t = NULL;
+ lapack_complex_float* tb_t = NULL;
+ lapack_complex_float* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_csytrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info );
+ }
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_csytrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_ctbtrs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( IS_C_NONZERO(alpha) ) {
- if( LAPACKE_ctf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( IS_C_NONZERO(alpha) ) {
+ if( LAPACKE_ctf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_c_nancheck( 1, &alpha, 1 ) ) {
- return -9;
- }
- if( IS_C_NONZERO(alpha) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -11;
+ if( LAPACKE_c_nancheck( 1, &alpha, 1 ) ) {
+ return -9;
+ }
+ if( IS_C_NONZERO(alpha) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_ctftri_work( matrix_layout, transr, uplo, diag, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpf_nancheck( n, arf ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpf_nancheck( n, arf ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ctfttp_work( matrix_layout, transr, uplo, n, arf, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpf_nancheck( n, arf ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpf_nancheck( n, arf ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ctfttr_work( matrix_layout, transr, uplo, n, arf, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, p, ldp ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, s, lds ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, p, ldp ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, s, lds ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
- }
- if( wantq ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
}
- }
- if( wantz ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -11;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
+ if( wantq ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -9;
+ }
+ }
+ if( wantz ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( wantq ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( wantz ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -15;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( wantq ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -13;
+ }
+ }
+ if( wantz ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -15;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
}
- }
- if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
- return -14;
- }
- if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, m, m, u, ldu ) ) {
- return -18;
+ if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
}
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, p, p, v, ldv ) ) {
- return -20;
+ if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
+ return -14;
+ }
+ if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, m, m, u, ldu ) ) {
+ return -18;
+ }
+ }
+ if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, p, p, v, ldv ) ) {
+ return -20;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, m, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, m, d, ldd ) ) {
- return -12;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, e, lde ) ) {
- return -14;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, f, ldf ) ) {
- return -16;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, m, d, ldd ) ) {
+ return -12;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, e, lde ) ) {
+ return -14;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, f, ldf ) ) {
+ return -16;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_a = LAPACKE_lsame( side, 'L' ) ? n :
- ( LAPACKE_lsame( side, 'R' ) ? k : 0 );
- nrows_a = LAPACKE_lsame( side, 'L' ) ? k :
- ( LAPACKE_lsame( side, 'R' ) ? m : 0 );
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) {
- return -13;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_a = LAPACKE_lsame( side, 'L' ) ? n :
+ ( LAPACKE_lsame( side, 'R' ) ? k : 0 );
+ nrows_a = LAPACKE_lsame( side, 'L' ) ? k :
+ ( LAPACKE_lsame( side, 'R' ) ? m : 0 );
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) {
+ return -13;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -15;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
+ return -11;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
lwork = LAPACKE_lsame( side, 'L' ) ? MAX(1,nb) * MAX(1,n) :
- ( LAPACKE_lsame( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 );
+ ( LAPACKE_lsame( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 );
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
if( work == NULL ) {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_ctpqrt2_work( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( storev, 'C' ) ) {
- ncols_v = k;
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- } else if( LAPACKE_lsame( storev, 'R' ) ) {
- ncols_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- nrows_v = k;
- } else {
- ncols_v = 0;
- nrows_v = 0;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) {
- return -12;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( storev, 'C' ) ) {
+ ncols_v = k;
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ } else if( LAPACKE_lsame( storev, 'R' ) ) {
+ ncols_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ nrows_v = k;
+ } else {
+ ncols_v = 0;
+ nrows_v = 0;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -14;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -16;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) {
+ return -12;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
+ return -10;
+ }
}
#endif
if (side=='l' || side=='L') {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ctptri_work( matrix_layout, uplo, diag, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_ctptrs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ctpttf_work( matrix_layout, transr, uplo, n, ap, arf );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_ctpttr_work( matrix_layout, uplo, n, ap, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -10;
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -6;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -4;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -4;
}
#endif
return LAPACKE_ctrexc_work( matrix_layout, compq, n, t, ldt, q, ldq, ifst,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -10;
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
}
#endif
return LAPACKE_ctrsyl_work( matrix_layout, trana, tranb, isgn, m, n, a, lda,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ctrtri_work( matrix_layout, uplo, diag, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_ctrtrs_work( matrix_layout, uplo, trans, diag, n, nrhs, a,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ctrttf_work( matrix_layout, transr, uplo, n, a, lda, arf );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_ctrttp_work( matrix_layout, uplo, n, a, lda, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cunbdb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
lapack_complex_float* work = NULL;
lapack_complex_float work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cunbdb", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) {
- return -9;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -11;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) {
- return -13;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) {
+ return -9;
+ }
+ if( LAPACKE_cge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) {
+ return -11;
+ }
+ if( LAPACKE_cge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) {
+ return -13;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function cunbdb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_complex_float* work, lapack_int lwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
+ }
/* Call LAPACK function and adjust info */
- LAPACK_cunbdb( &trans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
+ LAPACK_cunbdb( <rans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
x21, &ldx21, x22, &ldx22, theta, phi, taup1, taup2,
tauq1, tauq2, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- lapack_complex_float* x11_t = NULL;
- lapack_complex_float* x12_t = NULL;
- lapack_complex_float* x21_t = NULL;
- lapack_complex_float* x22_t = NULL;
- /* Check leading dimension(s) */
- if( ldx11 < q ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_cunbdb_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_cunbdb_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_cunbdb_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_cunbdb_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_cunbdb( &trans, &signs, &m, &p, &q, x11, &ldx11_t, x12,
- &ldx12_t, x21, &ldx21_t, x22, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x22_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_cge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_cge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_cge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_cge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
- /* Call LAPACK function and adjust info */
- LAPACK_cunbdb( &trans, &signs, &m, &p, &q, x11_t, &ldx11_t, x12_t,
- &ldx12_t, x21_t, &ldx21_t, x22_t, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- /* Release memory and exit */
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_cunbdb_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_cunbdb_work", info );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cuncsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_complex_float* work = NULL;
float rwork_query;
lapack_complex_float work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cuncsd", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -11;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) {
- return -13;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -15;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) {
- return -17;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) {
+ return -11;
+ }
+ if( LAPACKE_cge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) {
+ return -13;
+ }
+ if( LAPACKE_cge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) {
+ return -15;
+ }
+ if( LAPACKE_cge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) {
+ return -17;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = p ;
- nrows_x21 = m-p ;
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -8;
- }
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_x11 = p;
+ nrows_x21 = m-p;
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
+ return -8;
+ }
- if( LAPACKE_cge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -9;
+ if( LAPACKE_cge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
+ return -9;
+ }
}
-
#endif
/* Allocate memory for working array(s) */
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-MIN(MIN(p,m-p),MIN(q,m-q))) );
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function cuncsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int* iwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_cuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22, &ldx22,
- theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t, &ldv2t,
- work, &lwork, rwork, &lrwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- lapack_complex_float* x11_t = NULL;
- lapack_complex_float* x12_t = NULL;
- lapack_complex_float* x21_t = NULL;
- lapack_complex_float* x22_t = NULL;
- lapack_complex_float* u1_t = NULL;
- lapack_complex_float* u2_t = NULL;
- lapack_complex_float* v1t_t = NULL;
- lapack_complex_float* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -23;
- LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -25;
- LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -27;
- LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
- return info;
- }
- if( ldx11 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lrwork == -1 || lwork == -1 ) {
- LAPACK_cuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m,
- &p, &q, x11, &ldx11_t, x12, &ldx12_t, x21, &ldx21_t,
- x22, &ldx22_t, theta, u1, &ldu1_t, u2, &ldu2_t, v1t,
- &ldv1t_t, v2t, &ldv2t_t, work, &lwork, rwork,
- &lrwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
}
- x22_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_5;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_6;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (lapack_complex_float*)
- LAPACKE_malloc( sizeof(lapack_complex_float) *
- ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_7;
- }
- }
- /* Transpose input matrices */
- LAPACKE_cge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_cge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_cge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_cge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
/* Call LAPACK function and adjust info */
- LAPACK_cuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t,
- x22_t, &ldx22_t, theta, u1_t, &ldu1_t, u2_t, &ldu2_t,
- v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, work, &lwork, rwork,
- &lrwork, iwork, &info );
+ LAPACK_cuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, <rans, &signs, &m,
+ &p, &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22,
+ &ldx22, theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
+ &ldv2t, work, &lwork, rwork, &lrwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
- /* Transpose output matrices */
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_7:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_6:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_5:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_4:
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_c_nancheck( MIN(m,k), tau, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_c_nancheck( MIN(m,k), tau, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( n-1, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( n-1, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n-1, tau, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n-1, tau, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nq = LAPACKE_lsame( side, 'l' ) ? m : n;
- r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
- if( LAPACKE_cge_nancheck( matrix_layout, r, MIN(nq,k), a, lda ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_c_nancheck( MIN(nq,k), tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nq = LAPACKE_lsame( side, 'l' ) ? m : n;
+ r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
+ if( LAPACKE_cge_nancheck( matrix_layout, r, MIN(nq,k), a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_c_nancheck( MIN(nq,k), tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_cge_nancheck( matrix_layout, r, r, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_c_nancheck( m-1, tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_cge_nancheck( matrix_layout, r, r, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_c_nancheck( m-1, tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_c_nancheck( k, tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_cge_nancheck( matrix_layout, r, r, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_c_nancheck( m-1, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_cge_nancheck( matrix_layout, r, r, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_c_nancheck( m-1, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_cpp_nancheck( n, ap ) ) {
- return -4;
- }
- if( LAPACKE_c_nancheck( n-1, tau, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_cpp_nancheck( n, ap ) ) {
+ return -4;
+ }
+ if( LAPACKE_c_nancheck( n-1, tau, 1 ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_cpp_nancheck( r, ap ) ) {
- return -7;
- }
- if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -9;
- }
- if( LAPACKE_c_nancheck( m-1, tau, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_cpp_nancheck( r, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -9;
+ }
+ if( LAPACKE_c_nancheck( m-1, tau, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dbbcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
double* work = NULL;
double work_query;
- lapack_int nrows_u1, nrows_u2, nrows_v1t, nrows_v2t;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_dbbcsd", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- if( LAPACKE_d_nancheck( q-1, phi, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( q, theta, 1 ) ) {
- return -10;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_u1, p, u1, ldu1 ) ) {
- return -12;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( q-1, phi, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_u2, m-p, u2, ldu2 ) ) {
- return -14;
+ if( LAPACKE_d_nancheck( q, theta, 1 ) ) {
+ return -10;
}
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v1t, q, v1t, ldv1t ) ) {
- return -16;
+ if( LAPACKE_lsame( jobu1, 'y' ) ) {
+ if( LAPACKE_dge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) {
+ return -12;
+ }
}
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v2t, m-q, v2t, ldv2t ) ) {
- return -18;
+ if( LAPACKE_lsame( jobu2, 'y' ) ) {
+ if( LAPACKE_dge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_lsame( jobv1t, 'y' ) ) {
+ if( LAPACKE_dge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) {
+ return -16;
+ }
+ }
+ if( LAPACKE_lsame( jobv2t, 'y' ) ) {
+ if( LAPACKE_dge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) {
+ return -18;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dbbcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
double* work, lapack_int lwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
+ }
/* Call LAPACK function and adjust info */
- LAPACK_dbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
+ LAPACK_dbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, <rans, &m, &p, &q,
theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
&ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e,
work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- double* u1_t = NULL;
- double* u2_t = NULL;
- double* v1t_t = NULL;
- double* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
- v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e,
- b22d, b22e, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_dge_trans( matrix_layout, nrows_u1, p, u1, ldu1, u1_t,
- ldu1_t );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_dge_trans( matrix_layout, nrows_u2, m-p, u2, ldu2, u2_t,
- ldu2_t );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_dge_trans( matrix_layout, nrows_v1t, q, v1t, ldv1t, v1t_t,
- ldv1t_t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_dge_trans( matrix_layout, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
- ldv2t_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_dbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
- &ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
- b21e, b22d, b22e, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dbdsdc
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( ncc != 0 ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, ncc, c, ldc ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( ncc != 0 ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, ncc, c, ldc ) ) {
+ return -13;
+ }
}
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -8;
- }
- if( nru != 0 ) {
- if( LAPACKE_dge_nancheck( matrix_layout, nru, n, u, ldu ) ) {
- return -11;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -7;
}
- }
- if( ncvt != 0 ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -8;
+ }
+ if( nru != 0 ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, nru, n, u, ldu ) ) {
+ return -11;
+ }
+ }
+ if( ncvt != 0 ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n - 1, e, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( n - 1, e, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for work arrays */
}
/* Call middle-level interface */
info = LAPACKE_dbdsvdx_work( matrix_layout, uplo, jobz, range,
- n, d, e, vl, vu, il, iu, ns, s, z,
- ldz, work, iwork);
+ n, d, e, vl, vu, il, iu, ns, s, z,
+ ldz, work, iwork);
/* Backup significant data from working array(s) */
for( i=0; i<12*n-1; i++ ) {
superb[i] = iwork[i+1];
#include "lapacke_utils.h"
lapack_int LAPACKE_dbdsvdx_work( int matrix_layout, char uplo, char jobz, char range,
- lapack_int n, double* d, double* e,
- double vl, double vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- double* s, double* z, lapack_int ldz,
- double* work, lapack_int* iwork )
+ lapack_int n, double* d, double* e,
+ double vl, double vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ double* s, double* z, lapack_int ldz,
+ double* work, lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_dbdsvdx( &uplo, &jobz, &range, &n, d, e, &vl, &vu,
- &il, &iu, ns, s, z, &ldz,
+ &il, &iu, ns, s, z, &ldz,
work, iwork, &info );
if( info < 0 ) {
info = info - 1;
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( jobz, 'v' ) ) {
z_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldz_t * MAX(2*n,1) );
+ LAPACKE_malloc( sizeof(double) * ldz_t * MAX(ncols_z,1) );
if( z_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Call LAPACK function and adjust info */
LAPACK_dbdsvdx( &uplo, &jobz, &range, &n, d, e, &vl, &vu,
- &il, &iu, ns, s, z_t, &ldz_t, work,
- iwork, &info );
+ &il, &iu, ns, s, z_t, &ldz_t, work,
+ iwork, &info );
if( info < 0 ) {
info = info - 1;
}
const double* d, double* sep )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_ddisna_work( job, m, n, d, sep );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( ncc != 0 ) {
- if( LAPACKE_dge_nancheck( matrix_layout, m, ncc, c, ldc ) ) {
- return -16;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -8;
+ }
+ if( ncc != 0 ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, m, ncc, c, ldc ) ) {
+ return -16;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dgbequ_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dgbequb_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -9;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
+ return -9;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -25;
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
+ return -10;
}
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -13;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -14;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -25;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -17;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -17;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_dgbsv_work( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -15;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
+ ldafb ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -14;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -16;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -15;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -14;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -15;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
+ ldafb ) ) {
+ return -10;
+ }
}
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -27;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -16;
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -14;
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -15;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -27;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -14;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dgbtrf_work( matrix_layout, m, n, kl, ku, ab, ldab, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_dgbtrs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, scale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, m, v, ldv ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, scale, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, m, v, ldv ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_dgebak_work( matrix_layout, job, side, n, ilo, ihi, scale, m,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
+ LAPACKE_lsame( job, 's' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dgeequ_work( matrix_layout, m, n, a, lda, r, c, rowcnd,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dgeequb_work( matrix_layout, m, n, a, lda, r, c, rowcnd,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
- nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
+ nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dgelq
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
-lapack_int LAPACKE_dgelq_work( int matrix_layout, lapack_int m, lapack_int n,
- double* a, lapack_int lda,
- double* t, lapack_int tsize )
+lapack_int LAPACKE_dgelq( int matrix_layout, lapack_int m, lapack_int n,
+ double* a, lapack_int lda,
+ double* t, lapack_int tsize )
{
lapack_int info = 0;
lapack_int lwork = -1;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( tsize, t, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( tsize, t, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( tsize, t, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( tsize, t, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -12;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -12;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
+ return -10;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dgeqrt2_work( matrix_layout, m, n, a, lda, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dgeqrt3_work( matrix_layout, m, n, a, lda, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -23;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -11;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -12;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -23;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -15;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -15;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_dgesv_work( matrix_layout, n, nrhs, a, lda, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
info = LAPACKE_dgesvdx_work( matrix_layout, jobu, jobvt, range,
- m, n, a, lda, vl, vu, il, iu, ns, s, u,
+ m, n, a, lda, vl, vu, il, iu, ns, s, u,
ldu, vt, ldvt, &work_query, lwork, iwork );
if( info != 0 ) {
goto exit_level_0;
}
/* Call middle-level interface */
info = LAPACKE_dgesvdx_work( matrix_layout, jobu, jobvt, range,
- m, n, a, lda, vl, vu, il, iu, ns, s, u,
- ldu, vt, ldvt, work, lwork, iwork );
+ m, n, a, lda, vl, vu, il, iu, ns, s, u,
+ ldu, vt, ldvt, work, lwork, iwork );
/* Backup significant data from working array(s) */
for( i=0; i<12*MIN(m,n)-1; i++ ) {
superb[i] = iwork[i+1];
#include "lapacke_utils.h"
lapack_int LAPACKE_dgesvdx_work( int matrix_layout, char jobu, char jobvt, char range,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- double* s, double* u, lapack_int ldu,
- double* vt, lapack_int ldvt,
- double* work, lapack_int lwork, lapack_int* iwork )
+ lapack_int m, lapack_int n, double* a,
+ lapack_int lda, double vl, double vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ double* s, double* u, lapack_int ldu,
+ double* vt, lapack_int ldvt,
+ double* work, lapack_int lwork, lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_dgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda, &vl, &vu,
- &il, &iu, ns, s, u, &ldu, vt, &ldvt,
+ &il, &iu, ns, s, u, &ldu, vt, &ldvt,
work, &lwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_dgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu,
- &il, &iu, ns, s, u, &ldu_t, vt,
+ &il, &iu, ns, s, u, &ldu_t, vt,
&ldvt_t, work, &lwork, iwork, &info );
return (info < 0) ? (info - 1) : info;
}
LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_dgesvdx( &jobu, &jobvt, &range, &m, &n, a_t, &lda_t, &vl, &vu,
- &il, &iu, ns, s, u_t, &ldu_t, vt_t,
- &ldvt_t, work, &lwork, iwork, &info );
+ &il, &iu, ns, s, u_t, &ldu_t, vt_t,
+ &ldvt_t, work, &lwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) :
- ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0);
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, n, v, ldv ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) :
+ ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0);
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, n, v, ldv ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -13;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -12;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -13;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -25;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -13;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -25;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dgetf2_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dgetrf_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dgetrf2_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_dgetrs_work( matrix_layout, trans, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, lscale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n, rscale, 1 ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, m, v, ldv ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, lscale, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( n, rscale, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, m, v, ldv ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_dggbak_work( matrix_layout, job, side, n, ilo, ihi, lscale,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
+ LAPACKE_lsame( job, 'b' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -6;
+ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
+ LAPACKE_lsame( job, 'b' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, p, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, m, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, p, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -13;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -13;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -13;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -13;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( m, c, 1 ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( p, d, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( m, c, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_d_nancheck( p, d, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, p, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, m, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, p, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
+ }
}
#endif
info = LAPACKE_dggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
+ return -13;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
+ return -13;
+ }
}
#endif
/* Query optimal size for working array */
lapack_int* iwork = NULL;
double* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -3;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, dlf, 1 ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( n-1, duf, 1 ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -15;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( n, df, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, dlf, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
+ return -11;
+ }
+ if( LAPACKE_d_nancheck( n-1, duf, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -15;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dgtsv_work( matrix_layout, n, nrhs, dl, d, du, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
}
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n-1, dlf, 1 ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -7;
}
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n, df, 1 ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n-1, duf, 1 ) ) {
- return -11;
+ if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n-1, dlf, 1 ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
+ return -12;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n-1, duf, 1 ) ) {
+ return -11;
+ }
}
}
#endif
double* du2, lapack_int* ipiv )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dgttrf_work( n, dl, d, du, du2, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, du, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_dgttrs_work( matrix_layout, trans, n, nrhs, dl, d, du, du2,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -8;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -15;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -8;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -17;
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -15;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -17;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -13;
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_d_nancheck( n, wi, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( n, wr, 1 ) ) {
+ return -9;
}
- }
- if( LAPACKE_d_nancheck( n, wi, 1 ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( n, wr, 1 ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -7;
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -11;
+ }
}
}
#endif
double* est, lapack_int* kase, lapack_int* isave )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, est, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, x, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, est, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n, x, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_dlacn2_work( n, v, x, isgn, est, kase, isave );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dlacpy_work( matrix_layout, uplo, m, n, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dlag2s_work( matrix_layout, m, n, a, lda, sa, ldsa );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dlange
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int n, const double* a, lapack_int lda )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
double* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_dlange", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dlange
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
double* work )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
+ char norm_lapack;
if( matrix_layout == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
+ /* Call LAPACK function */
res = LAPACK_dlange( &norm, &m, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- double* a_t = NULL;
+ double* work_lapack = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_dlange_work", info );
return info;
}
- /* Allocate memory for temporary array(s) */
- a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
+ if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
+ norm_lapack = 'i';
+ } else if( LAPACKE_lsame( norm, 'i' ) ) {
+ norm_lapack = '1';
+ } else {
+ norm_lapack = norm;
+ }
+ /* Allocate memory for work array(s) */
+ if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
+ work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
+ if( work_lapack == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
}
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_dlange( &norm, &m, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
+ /* Call LAPACK function */
+ res = LAPACK_dlange( &norm_lapack, &n, &m, a, &lda, work_lapack );
/* Release memory and exit */
- LAPACKE_free( a_t );
+ if( work_lapack ) {
+ LAPACKE_free( work_lapack );
+ }
exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_dlange_work", info );
}
} else {
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dlansy
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
const double* a, lapack_int lda )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
double* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_dlansy", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dlansy
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
double* work )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
res = LAPACK_dlansy( &norm, &uplo, &n, a, &lda, work );
lapack_int lda )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
double* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_dlantr", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dlapmr_work( matrix_layout, forwrd, m, n, x, ldx, k );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dlapmt_work( matrix_layout, forwrd, m, n, x, ldx, k );
double LAPACKE_dlapy2( double x, double y )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_d_nancheck( 1, &y, 1 ) ) {
- return -2;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &x, 1 ) ) {
+ return -1;
+ }
+ if( LAPACKE_d_nancheck( 1, &y, 1 ) ) {
+ return -2;
+ }
}
#endif
return LAPACKE_dlapy2_work( x, y );
double LAPACKE_dlapy3( double x, double y, double z )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_d_nancheck( 1, &y, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( 1, &z, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &x, 1 ) ) {
+ return -1;
+ }
+ if( LAPACKE_d_nancheck( 1, &y, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_d_nancheck( 1, &z, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_dlapy3_work( x, y, z );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dlarfb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int ldc )
{
lapack_int info = 0;
- lapack_int ldwork = ( side=='l')?n:(( side=='r')?m:1);
+ lapack_int ldwork;
double* work = NULL;
lapack_int ncols_v, nrows_v;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
- nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -13;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, k, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
- if( k > nrows_v ) {
- LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
+ ( ( LAPACKE_lsame( storev, 'r' ) &&
+ LAPACKE_lsame( side, 'l' ) ) ? m :
+ ( ( LAPACKE_lsame( storev, 'r' ) &&
+ LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+ nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
+ LAPACKE_lsame( side, 'l' ) ) ? m :
+ ( ( LAPACKE_lsame( storev, 'c' ) &&
+ LAPACKE_lsame( side, 'r' ) ) ? n :
+ ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -13;
}
- if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k,
- &v[(nrows_v-k)*ldv], ldv ) )
- return -9;
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( k > ncols_v ) {
- LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
- return -8;
+ if( LAPACKE_dge_nancheck( matrix_layout, k, k, t, ldt ) ) {
+ return -11;
+ }
+ if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
+ return -9;
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
+ ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
+ if( k > nrows_v ) {
+ LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
+ return -8;
+ }
+ if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k,
+ &v[(nrows_v-k)*ldv], ldv ) )
+ return -9;
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
+ return -9;
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
+ ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( k > ncols_v ) {
+ LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
+ return -8;
+ }
+ if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
+ ldv ) )
+ return -9;
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
+ return -9;
}
- if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
- ldv ) )
- return -9;
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
- return -9;
}
#endif
+ if( LAPACKE_lsame( side, 'l' ) ) {
+ ldwork = n;
+ } else if( LAPACKE_lsame( side, 'r' ) ) {
+ ldwork = m;
+ } else {
+ ldwork = 1;
+ }
/* Allocate memory for working array(s) */
work = (double*)LAPACKE_malloc( sizeof(double) * ldwork * MAX(1,k) );
if( work == NULL ) {
lapack_int incx, double* tau )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, alpha, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, alpha, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_d_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_dlarfg_work( n, alpha, x, incx, tau );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
- nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
+ ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
+ nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
+ ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dlarft_work( matrix_layout, direct, storev, n, k, v, ldv, tau,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &tau, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( m, v, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &tau, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( m, v, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dlarfx_work( matrix_layout, side, m, n, v, tau, c, ldc,
double* r )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &f, 1 ) ) {
- return -1;
- }
- if( LAPACKE_d_nancheck( 1, &g, 1 ) ) {
- return -2;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &f, 1 ) ) {
+ return -1;
+ }
+ if( LAPACKE_d_nancheck( 1, &g, 1 ) ) {
+ return -2;
+ }
}
#endif
return LAPACKE_dlartgp_work( f, g, cs, sn, r );
double* sn )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &sigma, 1 ) ) {
- return -3;
- }
- if( LAPACKE_d_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_d_nancheck( 1, &y, 1 ) ) {
- return -2;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &sigma, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_d_nancheck( 1, &x, 1 ) ) {
+ return -1;
+ }
+ if( LAPACKE_d_nancheck( 1, &y, 1 ) ) {
+ return -2;
+ }
}
#endif
return LAPACKE_dlartgs_work( x, y, sigma, cs, sn );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- switch (type) {
- case 'G':
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ switch (type) {
+ case 'G':
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'L':
+ // TYPE = 'L' - lower triangle of general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_dgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
+ return -9;
+ }
+ break;
+ case 'U':
+ // TYPE = 'U' - upper triangle of general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_dgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
+ return -9;
+ }
+ break;
+ case 'H':
+ // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_dgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
+ return -9;
+ }
+ case 'B':
+ // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
+ if( LAPACKE_dsb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'Q':
+ // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
+ if( LAPACKE_dsb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'Z':
+ // TYPE = 'Z' - band matrix laid out for ?GBTRF
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
+ return -9;
+ }
+ break;
}
- break;
- case 'L':
- // TYPE = 'L' - lower triangle of general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_dgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
- return -9;
- }
- break;
- case 'U':
- // TYPE = 'U' - upper triangle of general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_dgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
- return -9;
- }
- break;
- case 'H':
- // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_dgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
- return -9;
- }
- case 'B':
- // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
- if( LAPACKE_dsb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
- return -9;
- }
- break;
- case 'Q':
- // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
- if( LAPACKE_dsb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
- return -9;
- }
- break;
- case 'Z':
- // TYPE = 'Z' - band matrix laid out for ?GBTRF
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
- return -9;
- }
- break;
}
#endif
return LAPACKE_dlascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda );
*****************************************************************************/
#ifndef LAPACK_DISABLE_NAN_CHECK
- if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) {
+ return -6;
+ }
}
#endif
lapack_int LAPACKE_dlasrt( char id, lapack_int n, double* d )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_dlasrt_work( id, n, d );
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function dlassq
+* Author: Julien langou
+* Generated February 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_dlassq( lapack_int n, double* x, lapack_int incx, double* scale, double* sumsq )
+{
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input vector `x` and in/out scalars `scale` and `sumsq` for NaNs */
+ if( LAPACKE_d_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
+ return -2;
+ }
+ if( LAPACKE_d_nancheck( 1, scale, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, sumsq, 1 ) ) {
+ return -5;
+ }
+ }
+#endif
+ return LAPACKE_dlassq_work( n, x, incx, scale, sumsq );
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function dlassq
+* Author: Julien Langou
+* Generated February, 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_dlassq_work( lapack_int n, double* x, lapack_int incx, double* scale, double* sumsq )
+{
+ lapack_int info = 0;
+ LAPACK_dlassq( &n, x, &incx, scale, sumsq );
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
-/*****************************************************************************
-* Disable the check as is below, the check below was checking for NaN
-* from lda to n since there is no (obvious) way to knowing m. This is not
-* a good idea. We could get a lower bound of m by scanning from ipiv. Or
-* we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable
-* the buggy Nan check.
-* See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827
-*****************************************************************************/
-/* if( LAPACKE_dge_nancheck( matrix_layout, lda, n, a, lda ) ) {
-* return -3;
-* }
-*/
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ /*****************************************************************************
+ * Disable the check as is below, the check below was checking for NaN
+ * from lda to n since there is no (obvious) way to knowing m. This is not
+ * a good idea. We could get a lower bound of m by scanning from ipiv. Or
+ * we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable
+ * the buggy Nan check.
+ * See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827
+ *****************************************************************************/
+ /* if( LAPACKE_dge_nancheck( matrix_layout, lda, n, a, lda ) ) {
+ * return -3;
+ * }
+ */
+ }
#endif
return LAPACKE_dlaswp_work( matrix_layout, n, a, lda, k1, k2, ipiv, incx );
}
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dlaswp
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_d_nancheck( 1, &cond, 1 ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( MIN(n,m), d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &dmax, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -14;
+ }
+ if( LAPACKE_d_nancheck( 1, &cond, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_d_nancheck( MIN(n,m), d, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &dmax, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dlauum_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dsp_nancheck( r, ap ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_dsp_nancheck( r, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -9;
+ }
+ if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dorbdb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
double* work = NULL;
double work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_dorbdb", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) {
- return -9;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -11;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) {
- return -13;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) {
+ return -9;
+ }
+ if( LAPACKE_dge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) {
+ return -11;
+ }
+ if( LAPACKE_dge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) {
+ return -13;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dorbdb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
+ }
/* Call LAPACK function and adjust info */
- LAPACK_dorbdb( &trans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
+ LAPACK_dorbdb( <rans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
x21, &ldx21, x22, &ldx22, theta, phi, taup1, taup2,
tauq1, tauq2, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- double* x11_t = NULL;
- double* x12_t = NULL;
- double* x21_t = NULL;
- double* x22_t = NULL;
- /* Check leading dimension(s) */
- if( ldx11 < q ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorbdb( &trans, &signs, &m, &p, &q, x11, &ldx11_t, x12,
- &ldx12_t, x21, &ldx21_t, x22, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (double*)LAPACKE_malloc( sizeof(double) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (double*)LAPACKE_malloc( sizeof(double) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x22_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_dge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_dge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_dge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
- /* Call LAPACK function and adjust info */
- LAPACK_dorbdb( &trans, &signs, &m, &p, &q, x11_t, &ldx11_t, x12_t,
- &ldx12_t, x21_t, &ldx21_t, x22_t, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- /* Release memory and exit */
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_dorbdb_work", info );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dorcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int* iwork = NULL;
double* work = NULL;
double work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_dorcsd", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -11;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) {
- return -13;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -15;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) {
- return -17;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) {
+ return -11;
+ }
+ if( LAPACKE_dge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) {
+ return -13;
+ }
+ if( LAPACKE_dge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) {
+ return -15;
+ }
+ if( LAPACKE_dge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) {
+ return -17;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dorcsd2by1
* Author: Intel Corporation
-* Generated December 2016
+* Generated November 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = p ;
- nrows_x21 = m-p ;
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_x11 = p;
+ nrows_x21 = m-p;
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
+ return -8;
+ }
+
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
+ return -9;
+ }
}
-
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -9;
- }
-
#endif
/* Allocate memory for working array(s) */
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-MIN(MIN(p,m-p),MIN(q,m-q))) );
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dorcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int* iwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_dorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22, &ldx22,
- theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t, &ldv2t,
- work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- double* x11_t = NULL;
- double* x12_t = NULL;
- double* x21_t = NULL;
- double* x22_t = NULL;
- double* u1_t = NULL;
- double* u2_t = NULL;
- double* v1t_t = NULL;
- double* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -23;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -25;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -27;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldx11 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_dorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m,
- &p, &q, x11, &ldx11_t, x12, &ldx12_t, x21, &ldx21_t,
- x22, &ldx22_t, theta, u1, &ldu1_t, u2, &ldu2_t, v1t,
- &ldv1t_t, v2t, &ldv2t_t, work, &lwork, iwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (double*)LAPACKE_malloc( sizeof(double) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (double*)LAPACKE_malloc( sizeof(double) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
}
- x22_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_5;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_6;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (double*)
- LAPACKE_malloc( sizeof(double) * ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_7;
- }
- }
- /* Transpose input matrices */
- LAPACKE_dge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_dge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_dge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_dge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
/* Call LAPACK function and adjust info */
- LAPACK_dorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t,
- x22_t, &ldx22_t, theta, u1_t, &ldu1_t, u2_t, &ldu2_t,
- v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, work, &lwork, iwork,
- &info );
+ LAPACK_dorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, <rans, &signs, &m,
+ &p, &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22,
+ &ldx22, theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
+ &ldv2t, work, &lwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
- /* Transpose output matrices */
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_7:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_6:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_5:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_4:
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_dorcsd_work", info );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( MIN(m,k), tau, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( MIN(m,k), tau, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dormbr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nq = LAPACKE_lsame( side, 'l' ) ? m : n;
- ar = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
- ac = LAPACKE_lsame( vect, 'q' ) ? MIN(nq,k) : nq;
- if( LAPACKE_dge_nancheck( matrix_layout, ar, ac, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( MIN(nq,k), tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nq = LAPACKE_lsame( side, 'l' ) ? m : n;
+ ar = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
+ ac = LAPACKE_lsame( vect, 'q' ) ? MIN(nq,k) : nq;
+ if( LAPACKE_dge_nancheck( matrix_layout, ar, ac, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_d_nancheck( MIN(nq,k), tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_layout, r, r, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_dge_nancheck( matrix_layout, r, r, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dormlq
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_layout, k, r, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_dge_nancheck( matrix_layout, k, r, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
lapack_int lda_t = MAX(1,k);
lapack_int ldc_t = MAX(1,m);
- double *a_t = NULL;
- double *c_t = NULL;
+ double *a_t = NULL;
+ double *c_t = NULL;
/* Check leading dimension(s) */
if( lda < r ) {
info = -8;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_dge_nancheck( matrix_layout, r, r, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_dge_nancheck( matrix_layout, r, r, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dpbequ_work( matrix_layout, uplo, n, kd, ab, ldab, s, scond,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dpbstf_work( matrix_layout, uplo, n, kb, bb, ldbb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_dpbsv_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dpbtrf_work( matrix_layout, uplo, n, kd, ab, ldab );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_dpbtrs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, a ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpf_nancheck( n, a ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dpftrf_work( matrix_layout, transr, uplo, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, a ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpf_nancheck( n, a ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dpftri_work( matrix_layout, transr, uplo, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, a ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpf_nancheck( n, a ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_dpftrs_work( matrix_layout, transr, uplo, n, nrhs, a, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_dpoequ_work( matrix_layout, n, a, lda, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_dpoequb_work( matrix_layout, n, a, lda, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -21;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -10;
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -21;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -13;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -13;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_dposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -23;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -23;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dpotrf_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dpotrf2_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dpotri_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_dpotrs_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -5;
- }
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dppequ_work( matrix_layout, uplo, n, ap, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dppsv_work( matrix_layout, uplo, n, nrhs, ap, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dpp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dpp_nancheck( n, afp ) ) {
+ return -7;
+ }
}
- }
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -9;
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dpptrf_work( matrix_layout, uplo, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dpptri_work( matrix_layout, uplo, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dpptrs_work( matrix_layout, uplo, n, nrhs, ap, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &tol, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, &tol, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
lapack_int info = 0;
double* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, ef, 1 ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n, df, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, ef, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dptsv_work( matrix_layout, n, nrhs, d, e, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n-1, ef, 1 ) ) {
- return -8;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n, df, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n-1, ef, 1 ) ) {
+ return -8;
+ }
}
}
#endif
lapack_int LAPACKE_dpttrf( lapack_int n, double* d, double* e )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_dpttrf_work( n, d, e );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dpttrs_work( matrix_layout, n, nrhs, d, e, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -18;
- }
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -15;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -18;
+ }
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -15;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_lsame( vect, 'u' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( vect, 'u' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
- na = LAPACKE_lsame( trans, 'n' ) ? n : k;
- if( LAPACKE_dge_nancheck( matrix_layout, na, ka, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) {
- return -10;
- }
- if( LAPACKE_dpf_nancheck( n, c ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
+ na = LAPACKE_lsame( trans, 'n' ) ? n : k;
+ if( LAPACKE_dge_nancheck( matrix_layout, na, ka, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_dpf_nancheck( n, c ) ) {
+ return -11;
+ }
}
#endif
return LAPACKE_dsfrk_work( matrix_layout, transr, uplo, trans, n, k, alpha,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dsp_nancheck( n, bp ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_dsp_nancheck( n, bp ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dspgst_work( matrix_layout, itype, uplo, n, ap, bp );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_dsp_nancheck( n, bp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_dsp_nancheck( n, bp ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_dsp_nancheck( n, bp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_dsp_nancheck( n, bp ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -13;
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -7;
- }
- if( LAPACKE_dsp_nancheck( n, bp ) ) {
- return -8;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -13;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -10;
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_dsp_nancheck( n, bp ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_dspsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dsp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dsp_nancheck( n, afp ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dsptrd_work( matrix_layout, uplo, n, ap, d, e, tau );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dsptrf_work( matrix_layout, uplo, n, ap, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_dsptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
lapack_int* iwork = NULL;
double* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -5;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -4;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -5;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dstegr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dstein
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, w, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n, w, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dstemr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int ldz_t = MAX(1,n);
double* z_t = NULL;
/* Check leading dimension(s) */
- if( ldz < n ) {
+ if( ldz < 1 || ( LAPACKE_lsame( jobz, 'v' ) && ldz < n ) ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_dstemr_work", info );
return info;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
lapack_int LAPACKE_dsterf( lapack_int n, double* d, double* e )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_dsterf_work( n, d, e );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dstev
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dstevd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dstevx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dsycon_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int info = 0;
lapack_int* iwork = NULL;
double* work = NULL;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_dsycon_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Call middle-level interface */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dsyevr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
+ lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 :
+ ( LAPACKE_lsame( range, 'a' ) ||
+ LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int lda_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dsyevx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
+ lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 :
+ ( LAPACKE_lsame( range, 'a' ) ||
+ LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int lda_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_dsygst_work( matrix_layout, itype, uplo, n, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function dsygvx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function dsysv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_dsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, double* a, lapack_int lda,
+ double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ double* work = NULL;
+ double work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_dsysv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = (lapack_int)work_query;
+ /* Allocate memory for work arrays */
+ work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_dsysv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function dsysv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_dsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, double* a, lapack_int lda,
+ double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, double* b, lapack_int ldb,
+ double* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_dsysv_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ double* a_t = NULL;
+ double* tb_t = NULL;
+ double* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_dsysv_aa_2stage( &uplo, &n, &nrhs, a, &lda_t,
+ tb, <b, ipiv, ipiv2, b, &ldb_t, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (double*)LAPACKE_malloc( sizeof(double) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_dsysv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dsysv_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, e, 1) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -24;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -24;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dsyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function dsytrf_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_dsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ double* a, lapack_int lda,
+ double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2 )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ double* work = NULL;
+ double work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_dsytrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = (lapack_int)work_query;
+ /* Allocate memory for work arrays */
+ work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_dsytrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function dsytrf_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_dsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ double* a, lapack_int lda,
+ double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ double* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_dsytrf_aa_2stage( &uplo, &n, a, &lda, tb,
+ <b, ipiv, ipiv2, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ double* a_t = NULL;
+ double* tb_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_dsytrf_aa_2stage( &uplo, &n, a, &lda_t,
+ tb, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (double*)LAPACKE_malloc( sizeof(double) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ /* Transpose input matrices */
+ LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_dsytrf_aa_2stage( &uplo, &n, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ /* Release memory and exit */
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dsytrf_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dsytri_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
double* work = NULL;
double work_query;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_dsytri_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_dsytrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dsytrs_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, e ,1 ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n, e ,1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_dsytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda,
- e, ipiv, b, ldb );
+ e, ipiv, b, ldb );
}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function dsytrs_aa
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
if( info != 0 ) {
goto exit_level_0;
}
- lwork = (lapack_int)work_query;
+ lwork = (lapack_int)work_query;
/* Allocate memory for work arrays */
work = (double*)
LAPACKE_malloc( sizeof(double) * lwork );
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function dsytrs_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_dsytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, double* a, lapack_int lda,
+ double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Call middle-level interface */
+ info = LAPACKE_dsytrs_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb );
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function dsytrs_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_dsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, double* a, lapack_int lda,
+ double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_dsytrs_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ double* a_t = NULL;
+ double* tb_t = NULL;
+ double* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (double*)LAPACKE_malloc( sizeof(double) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_dsytrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info );
+ }
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_dsytrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_dtbtrs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( IS_D_NONZERO(alpha) ) {
- if( LAPACKE_dtf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( IS_D_NONZERO(alpha) ) {
+ if( LAPACKE_dtf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
- return -9;
- }
- if( IS_D_NONZERO(alpha) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -11;
+ if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
+ return -9;
+ }
+ if( IS_D_NONZERO(alpha) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dtftri_work( matrix_layout, transr, uplo, diag, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, arf ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpf_nancheck( n, arf ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dtfttp_work( matrix_layout, transr, uplo, n, arf, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpf_nancheck( n, arf ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpf_nancheck( n, arf ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dtfttr_work( matrix_layout, transr, uplo, n, arf, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, p, ldp ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, s, lds ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, p, ldp ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, s, lds ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
- }
- if( wantq ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
}
- }
- if( wantz ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -11;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
+ if( wantq ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -9;
+ }
+ }
+ if( wantz ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( wantq ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( wantz ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -16;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( wantq ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -14;
+ }
+ }
+ if( wantz ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -16;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
}
- }
- if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
- return -14;
- }
- if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, m, m, u, ldu ) ) {
- return -18;
+ if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
}
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, p, p, v, ldv ) ) {
- return -20;
+ if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
+ return -14;
+ }
+ if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, m, m, u, ldu ) ) {
+ return -18;
+ }
+ }
+ if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, p, p, v, ldv ) ) {
+ return -20;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, m, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, m, d, ldd ) ) {
- return -12;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, e, lde ) ) {
- return -14;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, f, ldf ) ) {
- return -16;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, m, d, ldd ) ) {
+ return -12;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, e, lde ) ) {
+ return -14;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, f, ldf ) ) {
+ return -16;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_a = LAPACKE_lsame( side, 'L' ) ? n :
- ( LAPACKE_lsame( side, 'R' ) ? k : 0 );
- nrows_a = LAPACKE_lsame( side, 'L' ) ? k :
- ( LAPACKE_lsame( side, 'R' ) ? m : 0 );
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) {
- return -13;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_a = LAPACKE_lsame( side, 'L' ) ? n :
+ ( LAPACKE_lsame( side, 'R' ) ? k : 0 );
+ nrows_a = LAPACKE_lsame( side, 'L' ) ? k :
+ ( LAPACKE_lsame( side, 'R' ) ? m : 0 );
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) {
+ return -13;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -15;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
+ return -11;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_dtpqrt2_work( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( storev, 'C' ) ) {
- ncols_v = k;
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- } else if( LAPACKE_lsame( storev, 'R' ) ) {
- ncols_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- nrows_v = k;
- } else {
- ncols_v = 0;
- nrows_v = 0;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, k, k, t, ldt ) ) {
- return -12;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( storev, 'C' ) ) {
+ ncols_v = k;
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ } else if( LAPACKE_lsame( storev, 'R' ) ) {
+ ncols_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ nrows_v = k;
+ } else {
+ ncols_v = 0;
+ nrows_v = 0;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -14;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -16;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, k, k, t, ldt ) ) {
+ return -12;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
+ return -10;
+ }
}
#endif
if (side=='l' || side=='L') {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dtptri_work( matrix_layout, uplo, diag, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_dtptrs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dtpttf_work( matrix_layout, transr, uplo, n, ap, arf );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dtpttr_work( matrix_layout, uplo, n, ap, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -10;
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -6;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -4;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -4;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -10;
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
}
#endif
return LAPACKE_dtrsyl_work( matrix_layout, trana, tranb, isgn, m, n, a, lda,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dtrtri_work( matrix_layout, uplo, diag, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_dtrtrs_work( matrix_layout, uplo, trans, diag, n, nrhs, a,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_dtrttf_work( matrix_layout, transr, uplo, n, a, lda, arf );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_dtrttp_work( matrix_layout, uplo, n, a, lda, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native C interface to control NaN checking
+* Author: Intel Corporation
+* Generated July, 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+static int nancheck_flag = -1;
+
+void LAPACKE_set_nancheck( int flag )
+{
+ nancheck_flag = ( flag ) ? 1 : 0;
+}
+
+int LAPACKE_get_nancheck( )
+{
+ char* env;
+ if ( nancheck_flag != -1 ) {
+ return nancheck_flag;
+ }
+
+ /* Check environment variable, once and only once */
+ env = getenv( "LAPACKE_NANCHECK" );
+ if ( !env ) {
+ /* By default, NaN checking is enabled */
+ nancheck_flag = 1;
+ } else {
+ nancheck_flag = atoi( env ) ? 1 : 0;
+ }
+
+ return nancheck_flag;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sbbcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
float* work = NULL;
float work_query;
- lapack_int nrows_u1, nrows_u2, nrows_v1t, nrows_v2t;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_sbbcsd", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- if( LAPACKE_s_nancheck( q-1, phi, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( q, theta, 1 ) ) {
- return -10;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_u1, p, u1, ldu1 ) ) {
- return -12;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( q-1, phi, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_u2, m-p, u2, ldu2 ) ) {
- return -14;
+ if( LAPACKE_s_nancheck( q, theta, 1 ) ) {
+ return -10;
}
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v1t, q, v1t, ldv1t ) ) {
- return -16;
+ if( LAPACKE_lsame( jobu1, 'y' ) ) {
+ if( LAPACKE_sge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) {
+ return -12;
+ }
}
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v2t, m-q, v2t, ldv2t ) ) {
- return -18;
+ if( LAPACKE_lsame( jobu2, 'y' ) ) {
+ if( LAPACKE_sge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_lsame( jobv1t, 'y' ) ) {
+ if( LAPACKE_sge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) {
+ return -16;
+ }
+ }
+ if( LAPACKE_lsame( jobv2t, 'y' ) ) {
+ if( LAPACKE_sge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) {
+ return -18;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function sbbcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
float* work, lapack_int lwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
+ }
/* Call LAPACK function and adjust info */
- LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
+ LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, <rans, &m, &p, &q,
theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
&ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e,
work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- float* u1_t = NULL;
- float* u2_t = NULL;
- float* v1t_t = NULL;
- float* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
- v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e,
- b22d, b22e, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (float*)LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_sge_trans( matrix_layout, nrows_u1, p, u1, ldu1, u1_t,
- ldu1_t );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_sge_trans( matrix_layout, nrows_u2, m-p, u2, ldu2, u2_t,
- ldu2_t );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_sge_trans( matrix_layout, nrows_v1t, q, v1t, ldv1t, v1t_t,
- ldv1t_t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_sge_trans( matrix_layout, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
- ldv2t_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
- &ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
- b21e, b22d, b22e, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sbdsdc
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( ncc != 0 ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, ncc, c, ldc ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( ncc != 0 ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, ncc, c, ldc ) ) {
+ return -13;
+ }
}
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -8;
- }
- if( nru != 0 ) {
- if( LAPACKE_sge_nancheck( matrix_layout, nru, n, u, ldu ) ) {
- return -11;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -7;
}
- }
- if( ncvt != 0 ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -8;
+ }
+ if( nru != 0 ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, nru, n, u, ldu ) ) {
+ return -11;
+ }
+ }
+ if( ncvt != 0 ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n - 1, e, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( n - 1, e, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for work arrays */
}
/* Call middle-level interface */
info = LAPACKE_sbdsvdx_work( matrix_layout, uplo, jobz, range,
- n, d, e, vl, vu, il, iu, ns, s, z,
- ldz, work, iwork);
+ n, d, e, vl, vu, il, iu, ns, s, z,
+ ldz, work, iwork);
/* Backup significant data from working array(s) */
for( i=0; i<12*n-1; i++ ) {
superb[i] = iwork[i+1];
#include "lapacke_utils.h"
lapack_int LAPACKE_sbdsvdx_work( int matrix_layout, char uplo, char jobz, char range,
- lapack_int n, float* d, float* e,
- float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- float* s, float* z, lapack_int ldz,
- float* work, lapack_int* iwork )
+ lapack_int n, float* d, float* e,
+ float vl, float vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ float* s, float* z, lapack_int ldz,
+ float* work, lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sbdsvdx( &uplo, &jobz, &range, &n, d, e, &vl, &vu,
- &il, &iu, ns, s, z, &ldz,
+ &il, &iu, ns, s, z, &ldz,
work, iwork, &info );
if( info < 0 ) {
info = info - 1;
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( jobz, 'v' ) ) {
z_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldz_t * MAX(2*n,1) );
+ LAPACKE_malloc( sizeof(float) * ldz_t * MAX(ncols_z,1) );
if( z_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Call LAPACK function and adjust info */
LAPACK_sbdsvdx( &uplo, &jobz, &range, &n, d, e, &vl, &vu,
- &il, &iu, ns, s, z_t, &ldz_t, work,
- iwork, &info );
+ &il, &iu, ns, s, z_t, &ldz_t, work,
+ iwork, &info );
if( info < 0 ) {
info = info - 1;
}
float* sep )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sdisna_work( job, m, n, d, sep );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( ncc != 0 ) {
- if( LAPACKE_sge_nancheck( matrix_layout, m, ncc, c, ldc ) ) {
- return -16;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -8;
+ }
+ if( ncc != 0 ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, m, ncc, c, ldc ) ) {
+ return -16;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_sgbequ_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_sgbequb_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -9;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
+ return -9;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -25;
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
+ return -10;
}
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -13;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -14;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -25;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -17;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -17;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_sgbsv_work( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -15;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
+ ldafb ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -14;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -16;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -15;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -14;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -15;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
+ ldafb ) ) {
+ return -10;
+ }
}
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -27;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -16;
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -14;
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -15;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -27;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -14;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_sgbtrf_work( matrix_layout, m, n, kl, ku, ab, ldab, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_sgbtrs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, scale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, m, v, ldv ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, scale, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, m, v, ldv ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_sgebak_work( matrix_layout, job, side, n, ilo, ihi, scale, m,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
+ LAPACKE_lsame( job, 's' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sgeequ_work( matrix_layout, m, n, a, lda, r, c, rowcnd,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sgeequb_work( matrix_layout, m, n, a, lda, r, c, rowcnd,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
- nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
+ nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sgelq
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
-lapack_int LAPACKE_sgelq_work( int matrix_layout, lapack_int m, lapack_int n,
- float* a, lapack_int lda,
- float* t, lapack_int tsize )
+lapack_int LAPACKE_sgelq( int matrix_layout, lapack_int m, lapack_int n,
+ float* a, lapack_int lda,
+ float* t, lapack_int tsize )
{
lapack_int info = 0;
lapack_int lwork = -1;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sgemlq
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( tsize, t, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( tsize, t, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( tsize, t, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( tsize, t, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -12;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -12;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
+ return -10;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sgeqrt2_work( matrix_layout, m, n, a, lda, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sgeqrt3_work( matrix_layout, m, n, a, lda, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -23;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -11;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -12;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -23;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -15;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -15;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_sgesv_work( matrix_layout, n, nrhs, a, lda, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
info = LAPACKE_sgesvdx_work( matrix_layout, jobu, jobvt, range,
- m, n, a, lda, vl, vu, il, iu, ns, s, u,
+ m, n, a, lda, vl, vu, il, iu, ns, s, u,
ldu, vt, ldvt, &work_query, lwork, iwork );
if( info != 0 ) {
goto exit_level_0;
}
/* Call middle-level interface */
info = LAPACKE_sgesvdx_work( matrix_layout, jobu, jobvt, range,
- m, n, a, lda, vl, vu, il, iu, ns, s, u,
- ldu, vt, ldvt, work, lwork, iwork );
+ m, n, a, lda, vl, vu, il, iu, ns, s, u,
+ ldu, vt, ldvt, work, lwork, iwork );
/* Backup significant data from working array(s) */
for( i=0; i<12*MIN(m,n)-1; i++ ) {
superb[i] = iwork[i+1];
#include "lapacke_utils.h"
lapack_int LAPACKE_sgesvdx_work( int matrix_layout, char jobu, char jobvt, char range,
- lapack_int m, lapack_int n, float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- float* s, float* u, lapack_int ldu,
- float* vt, lapack_int ldvt,
- float* work, lapack_int lwork, lapack_int* iwork )
+ lapack_int m, lapack_int n, float* a,
+ lapack_int lda, float vl, float vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ float* s, float* u, lapack_int ldu,
+ float* vt, lapack_int ldvt,
+ float* work, lapack_int lwork, lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda, &vl, &vu,
- &il, &iu, ns, s, u, &ldu, vt, &ldvt,
+ &il, &iu, ns, s, u, &ldu, vt, &ldvt,
work, &lwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_sgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu,
- &il, &iu, ns, s, u, &ldu_t, vt,
+ &il, &iu, ns, s, u, &ldu_t, vt,
&ldvt_t, work, &lwork, iwork, &info );
return (info < 0) ? (info - 1) : info;
}
LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_sgesvdx( &jobu, &jobvt, &range, &m, &n, a_t, &lda_t, &vl, &vu,
- &il, &iu, ns, s, u_t, &ldu_t, vt_t,
- &ldvt_t, work, &lwork, iwork, &info );
+ &il, &iu, ns, s, u_t, &ldu_t, vt_t,
+ &ldvt_t, work, &lwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) :
- ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0 );
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, n, v, ldv ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) :
+ ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0 );
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, n, v, ldv ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -13;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -12;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_s_nancheck( n, c, 1 ) ) {
- return -13;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -25;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_s_nancheck( n, r, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_s_nancheck( n, c, 1 ) ) {
+ return -13;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -25;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_s_nancheck( n, r, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sgetf2_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sgetrf_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sgetrf2_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_sgetrs_work( matrix_layout, trans, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, lscale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n, rscale, 1 ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, m, v, ldv ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, lscale, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( n, rscale, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, m, v, ldv ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_sggbak_work( matrix_layout, job, side, n, ilo, ihi, lscale,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
+ LAPACKE_lsame( job, 'b' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -6;
+ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
+ LAPACKE_lsame( job, 'b' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, p, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, m, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, p, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -13;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -13;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -13;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -13;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( m, c, 1 ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( p, d, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( m, c, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_s_nancheck( p, d, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, p, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, m, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, p, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
+ }
}
#endif
/* Query optimal working array(s) size if requested */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
+ return -13;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
+ return -13;
+ }
}
#endif
/* Query optimal size for working array */
lapack_int* iwork = NULL;
float* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -3;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, dlf, 1 ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( n-1, duf, 1 ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -15;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( n, df, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, dlf, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
+ return -11;
+ }
+ if( LAPACKE_s_nancheck( n-1, duf, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -15;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_sgtsv_work( matrix_layout, n, nrhs, dl, d, du, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
}
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n-1, dlf, 1 ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -7;
}
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n, df, 1 ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n-1, duf, 1 ) ) {
- return -11;
+ if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n-1, dlf, 1 ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
+ return -12;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n-1, duf, 1 ) ) {
+ return -11;
+ }
}
}
#endif
float* du2, lapack_int* ipiv )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sgttrf_work( n, dl, d, du, du2, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, du, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_sgttrs_work( matrix_layout, trans, n, nrhs, dl, d, du, du2,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -8;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -15;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -8;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -17;
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -15;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -17;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -13;
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_s_nancheck( n, wi, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( n, wr, 1 ) ) {
+ return -9;
}
- }
- if( LAPACKE_s_nancheck( n, wi, 1 ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( n, wr, 1 ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -7;
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -11;
+ }
}
}
#endif
float* est, lapack_int* kase, lapack_int* isave )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, est, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, x, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, est, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n, x, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_slacn2_work( n, v, x, isgn, est, kase, isave );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_slacpy_work( matrix_layout, uplo, m, n, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, sa, ldsa ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, sa, ldsa ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_slag2d_work( matrix_layout, m, n, sa, ldsa, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function slange
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int n, const float* a, lapack_int lda )
{
lapack_int info = 0;
- float res = 0.;
+ float res = 0.;
float* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_slange", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function slange
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
float* work )
{
lapack_int info = 0;
- float res = 0.;
+ float res = 0.;
+ char norm_lapack;
if( matrix_layout == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
+ /* Call LAPACK function */
res = LAPACK_slange( &norm, &m, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- float* a_t = NULL;
+ float* work_lapack = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_slange_work", info );
return info;
}
- /* Allocate memory for temporary array(s) */
- a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
+ if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
+ norm_lapack = 'i';
+ } else if( LAPACKE_lsame( norm, 'i' ) ) {
+ norm_lapack = '1';
+ } else {
+ norm_lapack = norm;
+ }
+ /* Allocate memory for work array(s) */
+ if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
+ work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
+ if( work_lapack == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
}
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_slange( &norm, &m, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
+ /* Call LAPACK function */
+ res = LAPACK_slange( &norm_lapack, &n, &m, a, &lda, work_lapack );
/* Release memory and exit */
- LAPACKE_free( a_t );
+ if( work_lapack ) {
+ LAPACKE_free( work_lapack );
+ }
exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_slange_work", info );
}
} else {
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function slansy
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
const float* a, lapack_int lda )
{
lapack_int info = 0;
- float res = 0.;
+ float res = 0.;
float* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_slansy", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function slansy
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
float* work )
{
lapack_int info = 0;
- float res = 0.;
+ float res = 0.;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
res = LAPACK_slansy( &norm, &uplo, &n, a, &lda, work );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_slapmr_work( matrix_layout, forwrd, m, n, x, ldx, k );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_slapmt_work( matrix_layout, forwrd, m, n, x, ldx, k );
float LAPACKE_slapy2( float x, float y )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_s_nancheck( 1, &y, 1 ) ) {
- return -2;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &x, 1 ) ) {
+ return -1;
+ }
+ if( LAPACKE_s_nancheck( 1, &y, 1 ) ) {
+ return -2;
+ }
}
#endif
return LAPACKE_slapy2_work( x, y );
float LAPACKE_slapy3( float x, float y, float z )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_s_nancheck( 1, &y, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( 1, &z, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &x, 1 ) ) {
+ return -1;
+ }
+ if( LAPACKE_s_nancheck( 1, &y, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_s_nancheck( 1, &z, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_slapy3_work( x, y, z );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function slarfb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int ldc )
{
lapack_int info = 0;
- lapack_int ldwork = ( side=='l')?n:(( side=='r')?m:1);
+ lapack_int ldwork;
float* work = NULL;
lapack_int ncols_v, nrows_v;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
- nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -13;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, k, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_str_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
- if( k > nrows_v ) {
- LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
+ ( ( LAPACKE_lsame( storev, 'r' ) &&
+ LAPACKE_lsame( side, 'l' ) ) ? m :
+ ( ( LAPACKE_lsame( storev, 'r' ) &&
+ LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+ nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
+ LAPACKE_lsame( side, 'l' ) ) ? m :
+ ( ( LAPACKE_lsame( storev, 'c' ) &&
+ LAPACKE_lsame( side, 'r' ) ) ? n :
+ ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -13;
}
- if( LAPACKE_str_nancheck( matrix_layout, 'u', 'u', k,
- &v[(nrows_v-k)*ldv], ldv ) )
- return -9;
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_str_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( k > ncols_v ) {
- LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
- return -8;
+ if( LAPACKE_sge_nancheck( matrix_layout, k, k, t, ldt ) ) {
+ return -11;
+ }
+ if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( LAPACKE_str_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
+ return -9;
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
+ ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
+ if( k > nrows_v ) {
+ LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
+ return -8;
+ }
+ if( LAPACKE_str_nancheck( matrix_layout, 'u', 'u', k,
+ &v[(nrows_v-k)*ldv], ldv ) )
+ return -9;
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( LAPACKE_str_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
+ return -9;
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
+ ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( k > ncols_v ) {
+ LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
+ return -8;
+ }
+ if( LAPACKE_str_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
+ ldv ) )
+ return -9;
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
+ return -9;
}
- if( LAPACKE_str_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
- ldv ) )
- return -9;
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
- return -9;
}
#endif
+ if( LAPACKE_lsame( side, 'l' ) ) {
+ ldwork = n;
+ } else if( LAPACKE_lsame( side, 'r' ) ) {
+ ldwork = m;
+ } else {
+ ldwork = 1;
+ }
/* Allocate memory for working array(s) */
work = (float*)LAPACKE_malloc( sizeof(float) * ldwork * MAX(1,k) );
if( work == NULL ) {
lapack_int incx, float* tau )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, alpha, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, alpha, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_s_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_slarfg_work( n, alpha, x, incx, tau );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
- nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
+ ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
+ nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
+ ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_slarft_work( matrix_layout, direct, storev, n, k, v, ldv, tau,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &tau, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( m, v, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &tau, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( m, v, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_slarfx_work( matrix_layout, side, m, n, v, tau, c, ldc,
lapack_int LAPACKE_slartgp( float f, float g, float* cs, float* sn, float* r )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &f, 1 ) ) {
- return -1;
- }
- if( LAPACKE_s_nancheck( 1, &g, 1 ) ) {
- return -2;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &f, 1 ) ) {
+ return -1;
+ }
+ if( LAPACKE_s_nancheck( 1, &g, 1 ) ) {
+ return -2;
+ }
}
#endif
return LAPACKE_slartgp_work( f, g, cs, sn, r );
float* sn )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &sigma, 1 ) ) {
- return -3;
- }
- if( LAPACKE_s_nancheck( 1, &x, 1 ) ) {
- return -1;
- }
- if( LAPACKE_s_nancheck( 1, &y, 1 ) ) {
- return -2;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &sigma, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_s_nancheck( 1, &x, 1 ) ) {
+ return -1;
+ }
+ if( LAPACKE_s_nancheck( 1, &y, 1 ) ) {
+ return -2;
+ }
}
#endif
return LAPACKE_slartgs_work( x, y, sigma, cs, sn );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- switch (type) {
- case 'G':
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ switch (type) {
+ case 'G':
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'L':
+ // TYPE = 'L' - lower triangle of general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_sgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
+ return -9;
+ }
+ break;
+ case 'U':
+ // TYPE = 'U' - upper triangle of general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_sgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
+ return -9;
+ }
+ break;
+ case 'H':
+ // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_sgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
+ return -9;
+ }
+ case 'B':
+ // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
+ if( LAPACKE_ssb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'Q':
+ // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
+ if( LAPACKE_ssb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'Z':
+ // TYPE = 'Z' - band matrix laid out for ?GBTRF
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
+ return -9;
+ }
+ break;
}
- break;
- case 'L':
- // TYPE = 'L' - lower triangle of general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_sgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
- return -9;
- }
- break;
- case 'U':
- // TYPE = 'U' - upper triangle of general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_sgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
- return -9;
- }
- break;
- case 'H':
- // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_sgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
- return -9;
- }
- case 'B':
- // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
- if( LAPACKE_ssb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
- return -9;
- }
- break;
- case 'Q':
- // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
- if( LAPACKE_ssb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
- return -9;
- }
- break;
- case 'Z':
- // TYPE = 'Z' - band matrix laid out for ?GBTRF
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
- return -9;
- }
- break;
}
#endif
return LAPACKE_slascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda );
*****************************************************************************/
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) {
+ return -6;
+ }
}
#endif
lapack_int LAPACKE_slasrt( char id, lapack_int n, float* d )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_slasrt_work( id, n, d );
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function slassq
+* Author: Julien Langou
+* Generated February, 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_slassq( lapack_int n, float* x, lapack_int incx, float* scale, float* sumsq )
+{
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input vector `x` and in/out scalars `scale` and `sumsq` for NaNs */
+ if( LAPACKE_s_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
+ return -2;
+ }
+ if( LAPACKE_s_nancheck( 1, scale, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, sumsq, 1 ) ) {
+ return -5;
+ }
+ }
+#endif
+ return LAPACKE_slassq_work( n, x, incx, scale, sumsq );
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function slassq
+* Author: Julien Langou
+* Generated February, 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_slassq_work( lapack_int n, float* x, lapack_int incx, float* scale, float* sumsq )
+{
+ lapack_int info = 0;
+ LAPACK_slassq( &n, x, &incx, scale, sumsq );
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
-/*****************************************************************************
-* Disable the check as is below, the check below was checking for NaN
-* from lda to n since there is no (obvious) way to knowing m. This is not
-* a good idea. We could get a lower bound of m by scanning from ipiv. Or
-* we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable
-* the buggy Nan check.
-* See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827
-*****************************************************************************/
-/* if( LAPACKE_sge_nancheck( matrix_layout, lda, n, a, lda ) ) {
-* return -3;
-* }
-*/
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ /*****************************************************************************
+ * Disable the check as is below, the check below was checking for NaN
+ * from lda to n since there is no (obvious) way to knowing m. This is not
+ * a good idea. We could get a lower bound of m by scanning from ipiv. Or
+ * we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable
+ * the buggy Nan check.
+ * See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827
+ *****************************************************************************/
+ /* if( LAPACKE_sge_nancheck( matrix_layout, lda, n, a, lda ) ) {
+ * return -3;
+ * }
+ */
+ }
#endif
return LAPACKE_slaswp_work( matrix_layout, n, a, lda, k1, k2, ipiv, incx );
}
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function slaswp
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_s_nancheck( 1, &cond, 1 ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( MIN(n,m), d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &dmax, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -14;
+ }
+ if( LAPACKE_s_nancheck( 1, &cond, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_s_nancheck( MIN(n,m), d, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &dmax, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_slauum_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_ssp_nancheck( r, ap ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_ssp_nancheck( r, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -9;
+ }
+ if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sorbdb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
float* work = NULL;
float work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_sorbdb", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) {
- return -9;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -11;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) {
- return -13;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) {
+ return -9;
+ }
+ if( LAPACKE_sge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) {
+ return -11;
+ }
+ if( LAPACKE_sge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) {
+ return -13;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function sorbdb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
+ }
/* Call LAPACK function and adjust info */
- LAPACK_sorbdb( &trans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
+ LAPACK_sorbdb( <rans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
x21, &ldx21, x22, &ldx22, theta, phi, taup1, taup2,
tauq1, tauq2, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- float* x11_t = NULL;
- float* x12_t = NULL;
- float* x21_t = NULL;
- float* x22_t = NULL;
- /* Check leading dimension(s) */
- if( ldx11 < q ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorbdb( &trans, &signs, &m, &p, &q, x11, &ldx11_t, x12,
- &ldx12_t, x21, &ldx21_t, x22, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (float*)LAPACKE_malloc( sizeof(float) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (float*)LAPACKE_malloc( sizeof(float) * ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (float*)LAPACKE_malloc( sizeof(float) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x22_t = (float*)LAPACKE_malloc( sizeof(float) * ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_sge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_sge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_sge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
- /* Call LAPACK function and adjust info */
- LAPACK_sorbdb( &trans, &signs, &m, &p, &q, x11_t, &ldx11_t, x12_t,
- &ldx12_t, x21_t, &ldx21_t, x22_t, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- /* Release memory and exit */
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sorbdb_work", info );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sorcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int* iwork = NULL;
float* work = NULL;
float work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_sorcsd", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -11;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) {
- return -13;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -15;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) {
- return -17;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) {
+ return -11;
+ }
+ if( LAPACKE_sge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) {
+ return -13;
+ }
+ if( LAPACKE_sge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) {
+ return -15;
+ }
+ if( LAPACKE_sge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) {
+ return -17;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sorcsd2by1
* Author: Intel Corporation
-* Generated December 2016
+* Generated November 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = p ;
- nrows_x21 = m-p ;
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_x11 = p;
+ nrows_x21 = m-p;
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
+ return -8;
+ }
+
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
+ return -9;
+ }
}
-
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -9;
- }
-
#endif
/* Allocate memory for working array(s) */
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-MIN(MIN(p,m-p),MIN(q,m-q))) );
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function sorcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int* iwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22, &ldx22,
- theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t, &ldv2t,
- work, &lwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- float* x11_t = NULL;
- float* x12_t = NULL;
- float* x21_t = NULL;
- float* x22_t = NULL;
- float* u1_t = NULL;
- float* u2_t = NULL;
- float* v1t_t = NULL;
- float* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -23;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -25;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -27;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldx11 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m,
- &p, &q, x11, &ldx11_t, x12, &ldx12_t, x21, &ldx21_t,
- x22, &ldx22_t, theta, u1, &ldu1_t, u2, &ldu2_t, v1t,
- &ldv1t_t, v2t, &ldv2t_t, work, &lwork, iwork,
- &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (float*)LAPACKE_malloc( sizeof(float) * ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (float*)LAPACKE_malloc( sizeof(float) * ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (float*)LAPACKE_malloc( sizeof(float) * ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
}
- x22_t = (float*)LAPACKE_malloc( sizeof(float) * ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (float*)LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_5;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_6;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (float*)
- LAPACKE_malloc( sizeof(float) * ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_7;
- }
- }
- /* Transpose input matrices */
- LAPACKE_sge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_sge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_sge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_sge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
/* Call LAPACK function and adjust info */
- LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t,
- x22_t, &ldx22_t, theta, u1_t, &ldu1_t, u2_t, &ldu2_t,
- v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, work, &lwork, iwork,
- &info );
+ LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, <rans, &signs, &m,
+ &p, &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22,
+ &ldx22, theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
+ &ldv2t, work, &lwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
- /* Transpose output matrices */
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_7:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_6:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_5:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_4:
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( MIN(m,k), tau, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( MIN(m,k), tau, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sormbr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nq = LAPACKE_lsame( side, 'l' ) ? m : n;
- ar = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
- ac = LAPACKE_lsame( vect, 'q' ) ? MIN(nq,k) : nq;
- if( LAPACKE_sge_nancheck( matrix_layout, ar, ac, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( MIN(nq,k), tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nq = LAPACKE_lsame( side, 'l' ) ? m : n;
+ ar = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
+ ac = LAPACKE_lsame( vect, 'q' ) ? MIN(nq,k) : nq;
+ if( LAPACKE_sge_nancheck( matrix_layout, ar, ac, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_s_nancheck( MIN(nq,k), tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_layout, r, r, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_sge_nancheck( matrix_layout, r, r, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sormlq
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_layout, k, r, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_sge_nancheck( matrix_layout, k, r, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
lapack_int lda_t = MAX(1,k);
lapack_int ldc_t = MAX(1,m);
- float *a_t = NULL;
- float *c_t = NULL;
+ float *a_t = NULL;
+ float *c_t = NULL;
/* Check leading dimension(s) */
if( lda < r ) {
info = -8;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_s_nancheck( k, tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_sge_nancheck( matrix_layout, r, r, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_sge_nancheck( matrix_layout, r, r, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_spbequ_work( matrix_layout, uplo, n, kd, ab, ldab, s, scond,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_spbstf_work( matrix_layout, uplo, n, kb, bb, ldbb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_spbsv_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_spbtrf_work( matrix_layout, uplo, n, kd, ab, ldab );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_spbtrs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, a ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spf_nancheck( n, a ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_spftrf_work( matrix_layout, transr, uplo, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, a ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spf_nancheck( n, a ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_spftri_work( matrix_layout, transr, uplo, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, a ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spf_nancheck( n, a ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_spftrs_work( matrix_layout, transr, uplo, n, nrhs, a, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_spoequ_work( matrix_layout, n, a, lda, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_spoequb_work( matrix_layout, n, a, lda, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -21;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -10;
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -21;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -13;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -13;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_sposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -23;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -23;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_spotrf_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_spotrf2_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_spotri_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_spotrs_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -5;
- }
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_sppequ_work( matrix_layout, uplo, n, ap, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_sppsv_work( matrix_layout, uplo, n, nrhs, ap, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_spp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_spp_nancheck( n, afp ) ) {
+ return -7;
+ }
}
- }
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -9;
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_spptrf_work( matrix_layout, uplo, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_spptri_work( matrix_layout, uplo, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_spptrs_work( matrix_layout, uplo, n, nrhs, ap, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &tol, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, &tol, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
lapack_int info = 0;
float* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, ef, 1 ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n, df, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, ef, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_sptsv_work( matrix_layout, n, nrhs, d, e, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n, df, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n-1, ef, 1 ) ) {
- return -8;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n, df, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n-1, ef, 1 ) ) {
+ return -8;
+ }
}
}
#endif
lapack_int LAPACKE_spttrf( lapack_int n, float* d, float* e )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_spttrf_work( n, d, e );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_spttrs_work( matrix_layout, n, nrhs, d, e, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -18;
- }
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -15;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -18;
+ }
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -15;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_lsame( vect, 'u' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( vect, 'u' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
- na = LAPACKE_lsame( trans, 'n' ) ? n : k;
- if( LAPACKE_sge_nancheck( matrix_layout, na, ka, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) {
- return -10;
- }
- if( LAPACKE_spf_nancheck( n, c ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
+ na = LAPACKE_lsame( trans, 'n' ) ? n : k;
+ if( LAPACKE_sge_nancheck( matrix_layout, na, ka, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_spf_nancheck( n, c ) ) {
+ return -11;
+ }
}
#endif
return LAPACKE_ssfrk_work( matrix_layout, transr, uplo, trans, n, k, alpha,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_ssp_nancheck( n, bp ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_ssp_nancheck( n, bp ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_sspgst_work( matrix_layout, itype, uplo, n, ap, bp );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_ssp_nancheck( n, bp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_ssp_nancheck( n, bp ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_ssp_nancheck( n, bp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_ssp_nancheck( n, bp ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -13;
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -7;
- }
- if( LAPACKE_ssp_nancheck( n, bp ) ) {
- return -8;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -13;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -10;
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_ssp_nancheck( n, bp ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_sspsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_ssp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_ssp_nancheck( n, afp ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_ssptrd_work( matrix_layout, uplo, n, ap, d, e, tau );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_ssptrf_work( matrix_layout, uplo, n, ap, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_ssptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
lapack_int* iwork = NULL;
float* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -8;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -9;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -5;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -4;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -5;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sstegr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sstein
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, w, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n, w, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function sstemr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int ldz_t = MAX(1,n);
float* z_t = NULL;
/* Check leading dimension(s) */
- if( ldz < n ) {
+ if( ldz < 1 || ( LAPACKE_lsame( jobz, 'v' ) && ldz < n ) ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_sstemr_work", info );
return info;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
lapack_int LAPACKE_ssterf( lapack_int n, float* d, float* e )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_ssterf_work( n, d, e );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sstev
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sstevd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function sstevx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_s_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_s_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function ssycon_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int info = 0;
lapack_int* iwork = NULL;
float* work = NULL;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_ssycon_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Call middle-level interface */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function ssyevr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
+ lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 :
+ ( LAPACKE_lsame( range, 'a' ) ||
+ LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int lda_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function ssyevx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
+ lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 :
+ ( LAPACKE_lsame( range, 'a' ) ||
+ LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int lda_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_ssygst_work( matrix_layout, itype, uplo, n, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function ssygvx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function ssysv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_ssysv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, float* a, lapack_int lda,
+ float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, float* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ float* work = NULL;
+ float work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_ssysv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = (lapack_int)work_query;
+ /* Allocate memory for work arrays */
+ work = (float*)
+ LAPACKE_malloc( sizeof(float) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_ssysv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function ssysv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_ssysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, float* a, lapack_int lda,
+ float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, float* b, lapack_int ldb,
+ float* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_ssysv_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ float* a_t = NULL;
+ float* tb_t = NULL;
+ float* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_ssysv_aa_2stage( &uplo, &n, &nrhs, a, &lda_t,
+ tb, <b, ipiv, ipiv2, b, &ldb_t, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (float*)LAPACKE_malloc( sizeof(float) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_ssysv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function ssysv_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, e, 1) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( nparams>0 ) {
- if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
- return -24;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_s_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
+ return -24;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_s_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_ssyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function ssytrf_aa_2stage
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_ssytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ float* a, lapack_int lda,
+ float* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2 )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ float* work = NULL;
+ float work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_ssytrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = (lapack_int)work_query;
+ /* Allocate memory for work arrays */
+ work = (float*)
+ LAPACKE_malloc( sizeof(float) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_ssytrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function ssytrf_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_ssytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ float* a, lapack_int lda,
+ float* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ float* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_ssytrf_aa_2stage( &uplo, &n, a, &lda, tb,
+ <b, ipiv, ipiv2, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ float* a_t = NULL;
+ float* tb_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_ssytrf_aa_2stage( &uplo, &n, a, &lda_t,
+ tb, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (float*)LAPACKE_malloc( sizeof(float) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ /* Transpose input matrices */
+ LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_ssytrf_aa_2stage( &uplo, &n, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ /* Release memory and exit */
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function ssytrf_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function ssytri_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
float* work = NULL;
float work_query;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_ssytri_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_s_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_s_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_ssytrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_s_nancheck( n, e ,1 ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_s_nancheck( n, e ,1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_ssytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda,
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function ssytrs_aa
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
if( info != 0 ) {
goto exit_level_0;
}
- lwork = (lapack_int)work_query;
+ lwork = (lapack_int)work_query;
/* Allocate memory for work arrays */
work = (float*)
LAPACKE_malloc( sizeof(float) * lwork );
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function ssytrs_aa_2stage
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_ssytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, float* a, lapack_int lda,
+ float* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ float* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Call middle-level interface */
+ info = LAPACKE_ssytrs_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb );
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function ssytrs_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_ssytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, float* a, lapack_int lda,
+ float* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, float* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_ssytrs_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ float* a_t = NULL;
+ float* tb_t = NULL;
+ float* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (float*)LAPACKE_malloc( sizeof(float) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_ssytrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info );
+ }
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_ssytrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_stb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_stb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_stb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_stbtrs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( IS_S_NONZERO(alpha) ) {
- if( LAPACKE_stf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( IS_S_NONZERO(alpha) ) {
+ if( LAPACKE_stf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
- return -9;
- }
- if( IS_S_NONZERO(alpha) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -11;
+ if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) {
+ return -9;
+ }
+ if( IS_S_NONZERO(alpha) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_stf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_stftri_work( matrix_layout, transr, uplo, diag, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, arf ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spf_nancheck( n, arf ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_stfttp_work( matrix_layout, transr, uplo, n, arf, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spf_nancheck( n, arf ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spf_nancheck( n, arf ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_stfttr_work( matrix_layout, transr, uplo, n, arf, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, p, ldp ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, s, lds ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, p, ldp ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, s, lds ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
- }
- if( wantq ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
}
- }
- if( wantz ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -11;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
+ if( wantq ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -9;
+ }
+ }
+ if( wantz ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( wantq ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( wantz ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -16;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( wantq ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -14;
+ }
+ }
+ if( wantz ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -16;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
}
- }
- if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
- return -14;
- }
- if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, m, m, u, ldu ) ) {
- return -18;
+ if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
}
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, p, p, v, ldv ) ) {
- return -20;
+ if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) {
+ return -14;
+ }
+ if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, m, m, u, ldu ) ) {
+ return -18;
+ }
+ }
+ if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, p, p, v, ldv ) ) {
+ return -20;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, m, d, ldd ) ) {
- return -12;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, e, lde ) ) {
- return -14;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, f, ldf ) ) {
- return -16;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, m, d, ldd ) ) {
+ return -12;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, e, lde ) ) {
+ return -14;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, f, ldf ) ) {
+ return -16;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_a = LAPACKE_lsame( side, 'L' ) ? n :
- ( LAPACKE_lsame( side, 'R' ) ? k : 0 );
- nrows_a = LAPACKE_lsame( side, 'L' ) ? k :
- ( LAPACKE_lsame( side, 'R' ) ? m : 0 );
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) {
- return -13;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_a = LAPACKE_lsame( side, 'L' ) ? n :
+ ( LAPACKE_lsame( side, 'R' ) ? k : 0 );
+ nrows_a = LAPACKE_lsame( side, 'L' ) ? k :
+ ( LAPACKE_lsame( side, 'R' ) ? m : 0 );
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) {
+ return -13;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -15;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
+ return -11;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
lwork = LAPACKE_lsame( side, 'L' ) ? MAX(1,nb) * MAX(1,n) :
- ( LAPACKE_lsame( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 );
+ ( LAPACKE_lsame( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 );
work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_stpqrt2_work( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( storev, 'C' ) ) {
- ncols_v = k;
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- } else if( LAPACKE_lsame( storev, 'R' ) ) {
- ncols_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- nrows_v = k;
- } else {
- ncols_v = 0;
- nrows_v = 0;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, k, k, t, ldt ) ) {
- return -12;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( storev, 'C' ) ) {
+ ncols_v = k;
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ } else if( LAPACKE_lsame( storev, 'R' ) ) {
+ ncols_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ nrows_v = k;
+ } else {
+ ncols_v = 0;
+ nrows_v = 0;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -14;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -16;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, k, k, t, ldt ) ) {
+ return -12;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
+ return -10;
+ }
}
#endif
if (side=='l' || side=='L') {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_stptri_work( matrix_layout, uplo, diag, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_stptrs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_stpttf_work( matrix_layout, transr, uplo, n, ap, arf );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_spp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_spp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_stpttr_work( matrix_layout, uplo, n, ap, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -10;
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -6;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -4;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -4;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -10;
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
}
#endif
return LAPACKE_strsyl_work( matrix_layout, trana, tranb, isgn, m, n, a, lda,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_strtri_work( matrix_layout, uplo, diag, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_strtrs_work( matrix_layout, uplo, trans, diag, n, nrhs, a,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_strttf_work( matrix_layout, transr, uplo, n, a, lda, arf );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_strttp_work( matrix_layout, uplo, n, a, lda, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zbbcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lrwork = -1;
double* rwork = NULL;
double rwork_query;
- lapack_int nrows_u1, nrows_u2, nrows_v1t, nrows_v2t;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zbbcsd", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- if( LAPACKE_d_nancheck( q-1, phi, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( q, theta, 1 ) ) {
- return -10;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_u1, p, u1, ldu1 ) ) {
- return -12;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( q-1, phi, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_u2, m-p, u2, ldu2 ) ) {
- return -14;
+ if( LAPACKE_d_nancheck( q, theta, 1 ) ) {
+ return -10;
}
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v1t, q, v1t, ldv1t ) ) {
- return -16;
+ if( LAPACKE_lsame( jobu1, 'y' ) ) {
+ if( LAPACKE_zge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) {
+ return -12;
+ }
}
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v2t, m-q, v2t, ldv2t ) ) {
- return -18;
+ if( LAPACKE_lsame( jobu2, 'y' ) ) {
+ if( LAPACKE_zge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_lsame( jobv1t, 'y' ) ) {
+ if( LAPACKE_zge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) {
+ return -16;
+ }
+ }
+ if( LAPACKE_lsame( jobv2t, 'y' ) ) {
+ if( LAPACKE_zge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) {
+ return -18;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zbbcsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lrwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
+ }
/* Call LAPACK function and adjust info */
- LAPACK_zbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
+ LAPACK_zbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, <rans, &m, &p, &q,
theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
&ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e,
rwork, &lrwork, &info );
if( info < 0 ) {
info = info - 1;
}
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- lapack_complex_double* u1_t = NULL;
- lapack_complex_double* u2_t = NULL;
- lapack_complex_double* v1t_t = NULL;
- lapack_complex_double* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -13;
- LAPACKE_xerbla( "LAPACKE_zbbcsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -15;
- LAPACKE_xerbla( "LAPACKE_zbbcsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -17;
- LAPACKE_xerbla( "LAPACKE_zbbcsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -19;
- LAPACKE_xerbla( "LAPACKE_zbbcsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lrwork == -1 ) {
- LAPACK_zbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
- v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e,
- b22d, b22e, rwork, &lrwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- }
- /* Transpose input matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_zge_trans( matrix_layout, nrows_u1, p, u1, ldu1, u1_t,
- ldu1_t );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_zge_trans( matrix_layout, nrows_u2, m-p, u2, ldu2, u2_t,
- ldu2_t );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_zge_trans( matrix_layout, nrows_v1t, q, v1t, ldv1t, v1t_t,
- ldv1t_t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_zge_trans( matrix_layout, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
- ldv2t_t );
- }
- /* Call LAPACK function and adjust info */
- LAPACK_zbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
- theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
- &ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
- b21e, b22d, b22e, rwork, &lrwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_3:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_2:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_1:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_zbbcsd_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zbbcsd_work", info );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( ncc != 0 ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, ncc, c, ldc ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( ncc != 0 ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, ncc, c, ldc ) ) {
+ return -13;
+ }
}
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -8;
- }
- if( nru != 0 ) {
- if( LAPACKE_zge_nancheck( matrix_layout, nru, n, u, ldu ) ) {
- return -11;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -7;
}
- }
- if( ncvt != 0 ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -8;
+ }
+ if( nru != 0 ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, nru, n, u, ldu ) ) {
+ return -11;
+ }
+ }
+ if( ncvt != 0 ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( ncc != 0 ) {
- if( LAPACKE_zge_nancheck( matrix_layout, m, ncc, c, ldc ) ) {
- return -16;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -8;
+ }
+ if( ncc != 0 ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, m, ncc, c, ldc ) ) {
+ return -16;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_zgbequ_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_zgbequb_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -9;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
+ return -9;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -25;
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) {
+ return -10;
}
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -13;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -14;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -25;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -17;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -17;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_zgbsv_work( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -15;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
+ ldafb ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -14;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -16;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -15;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -14;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
- ldafb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -15;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb,
+ ldafb ) ) {
+ return -10;
+ }
}
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -27;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -16;
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -14;
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -15;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -27;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -14;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_zgbtrf_work( matrix_layout, m, n, kl, ku, ab, ldab, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_zgbtrs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, scale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, m, v, ldv ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, scale, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, m, v, ldv ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_zgebak_work( matrix_layout, job, side, n, ilo, ihi, scale, m,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
- LAPACKE_lsame( job, 's' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
+ LAPACKE_lsame( job, 's' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zgeequ_work( matrix_layout, m, n, a, lda, r, c, rowcnd,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zgeequb_work( matrix_layout, m, n, a, lda, r, c, rowcnd,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
{
lapack_int info = 0;
lapack_int lwork = (
- // 1.1
- ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
+ // 1.1
+ ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? 2*n+1 :
//1.2
- ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
+ ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
!( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? n*n+3*n :
//2.1
- ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
- (!( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) )&&
+ ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
+ !( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) )&&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n :
//2.2
- ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
+ ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
!( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
!( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n :
( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 4*n*n:
- 1) ) ) ) ) ) ) ) );
+ 1) ) ) ) ) ) ) );
lapack_int lrwork = (
- // 1.1
- ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
+ // 1.1
+ ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,n+2*m) :
//1.2
!( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,2*n) :
//2.1
- ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
- (!( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) ) &&
+ ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
+ !( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) ) &&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX( 7, n+ 2*m ) :
//2.2
- ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
+ ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
!( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
!( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) :
( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) :
- 7) ) ) ) ) ) ) ) );
+ 7) ) ) ) ) ) ) );
lapack_int* iwork = NULL;
double* rwork = NULL;
lapack_complex_double* cwork = NULL;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
- nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
+ nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zgelq
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
-lapack_int LAPACKE_zgelq_work( int matrix_layout, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* t, lapack_int tsize )
+lapack_int LAPACKE_zgelq( int matrix_layout, lapack_int m, lapack_int n,
+ lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* t, lapack_int tsize )
{
lapack_int info = 0;
lapack_int lwork = -1;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zgemlq
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( tsize, t, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_z_nancheck( tsize, t, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_z_nancheck( tsize, t, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_z_nancheck( tsize, t, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -12;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -12;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zgeqr
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zgeqrt2_work( matrix_layout, m, n, a, lda, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zgeqrt3_work( matrix_layout, m, n, a, lda, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -23;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -11;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -12;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -23;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -15;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -15;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zgesdd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
if( LAPACKE_lsame( jobz, 'n' ) ) {
lrwork = MAX(1,7*MIN(m,n));
} else {
- lrwork = (size_t)MIN(m,n)*MAX(5*MIN(m,n)+7,2*MAX(m,n)+2*MIN(m,n)+1);
+ lrwork = (size_t)MAX(1,MIN(m,n)*MAX(5*MIN(m,n)+7,2*MAX(m,n)+2*MIN(m,n)+1));
}
/* Allocate memory for working array(s) */
iwork = (lapack_int*)
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_zgesv_work( matrix_layout, n, nrhs, a, lda, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
#include "lapacke_utils.h"
lapack_int LAPACKE_zgesvdx( int matrix_layout, char jobu, char jobvt, char range,
- lapack_int m, lapack_int n, lapack_complex_double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- double* s, lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* vt, lapack_int ldvt,
- lapack_int* superb )
+ lapack_int m, lapack_int n, lapack_complex_double* a,
+ lapack_int lda, double vl, double vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ double* s, lapack_complex_double* u, lapack_int ldu,
+ lapack_complex_double* vt, lapack_int ldvt,
+ lapack_int* superb )
{
lapack_int info = 0;
lapack_int lwork = -1;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
info = LAPACKE_zgesvdx_work( matrix_layout, jobu, jobvt, range,
- m, n, a, lda, vl, vu, il, iu, ns, s, u,
+ m, n, a, lda, vl, vu, il, iu, ns, s, u,
ldu, vt, ldvt, &work_query, lwork, rwork, iwork );
if( info != 0 ) {
goto exit_level_0;
lwork = LAPACK_Z2INT (work_query);
/* Allocate memory for work arrays */
work = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
+ LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Call middle-level interface */
info = LAPACKE_zgesvdx_work( matrix_layout, jobu, jobvt, range,
- m, n, a, lda, vl, vu, il, iu, ns, s, u,
- ldu, vt, ldvt, work, lwork, rwork, iwork );
+ m, n, a, lda, vl, vu, il, iu, ns, s, u,
+ ldu, vt, ldvt, work, lwork, rwork, iwork );
/* Backup significant data from working array(s) */
for( i=0; i<12*MIN(m,n)-1; i++ ) {
superb[i] = iwork[i+1];
#include "lapacke_utils.h"
lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char range,
- lapack_int m, lapack_int n, lapack_complex_double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, lapack_int* ns,
- double* s, lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* vt, lapack_int ldvt,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int* iwork )
+ lapack_int m, lapack_int n, lapack_complex_double* a,
+ lapack_int lda, double vl, double vu,
+ lapack_int il, lapack_int iu, lapack_int* ns,
+ double* s, lapack_complex_double* u, lapack_int ldu,
+ lapack_complex_double* vt, lapack_int ldvt,
+ lapack_complex_double* work, lapack_int lwork,
+ double* rwork, lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda, &vl, &vu,
- &il, &iu, ns, s, u, &ldu, vt, &ldvt,
+ &il, &iu, ns, s, u, &ldu, vt, &ldvt,
work, &lwork, rwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_zgesvdx( &jobu, &jobvt, &range, &m, &n, a, &lda_t, &vl, &vu,
- &il, &iu, ns, s, u, &ldu_t, vt,
+ &il, &iu, ns, s, u, &ldu_t, vt,
&ldvt_t, work, &lwork, rwork, iwork, &info );
return (info < 0) ? (info - 1) : info;
}
LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_zgesvdx( &jobu, &jobvt, &range, &m, &n, a_t, &lda_t, &vl, &vu,
- &il, &iu, ns, s, u_t, &ldu_t, vt_t,
+ &il, &iu, ns, s, u_t, &ldu_t, vt_t,
&ldvt_t, work, &lwork, rwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) :
- ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0);
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, n, v, ldv ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_v = LAPACKE_lsame( jobv, 'v' ) ? MAX(0,n) :
+ ( LAPACKE_lsame( jobv, 'a' ) ? MAX(0,mv) : 0);
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, n, v, ldv ) ) {
+ return -11;
+ }
}
}
#endif
}
if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ) {
v_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,n) );
+ LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,n) );
if( v_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -13;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -12;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -13;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'c' ) ) ) {
- if( LAPACKE_d_nancheck( n, c, 1 ) ) {
- return -13;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -25;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
- LAPACKE_lsame( *equed, 'r' ) ) ) {
- if( LAPACKE_d_nancheck( n, r, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'c' ) ) ) {
+ if( LAPACKE_d_nancheck( n, c, 1 ) ) {
+ return -13;
+ }
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -25;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
+ LAPACKE_lsame( *equed, 'r' ) ) ) {
+ if( LAPACKE_d_nancheck( n, r, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zgetf2_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zgetrf_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zgetrf2_work( matrix_layout, m, n, a, lda, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_zgetrs_work( matrix_layout, trans, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, lscale, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n, rscale, 1 ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, m, v, ldv ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, lscale, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( n, rscale, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, m, v, ldv ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_zggbak_work( matrix_layout, job, side, n, ilo, ihi, lscale,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
+ LAPACKE_lsame( job, 'b' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
- }
- if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
- LAPACKE_lsame( job, 'b' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -6;
+ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ||
+ LAPACKE_lsame( job, 'b' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, p, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_z_nancheck( n, d, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, m, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, p, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_z_nancheck( n, d, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -13;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -13;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -13;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -13;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_z_nancheck( m, c, 1 ) ) {
- return -9;
- }
- if( LAPACKE_z_nancheck( p, d, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_z_nancheck( m, c, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_z_nancheck( p, d, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, m, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, p, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, m, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, p, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
+ }
}
#endif
/* Query optimal size for working array */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
+ return -13;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
- return -12;
- }
- if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
+ return -13;
+ }
}
#endif
/* Query optimal size for working array */
lapack_int info = 0;
lapack_complex_double* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -8;
- }
- if( LAPACKE_z_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
- return -3;
- }
- if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_z_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_z_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_z_nancheck( n, df, 1 ) ) {
- return -9;
- }
- if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n-1, dlf, 1 ) ) {
- return -8;
- }
- if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) {
- return -11;
- }
- if( LAPACKE_z_nancheck( n-1, duf, 1 ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -15;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_z_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_z_nancheck( n, df, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( n-1, dlf, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) {
+ return -11;
+ }
+ if( LAPACKE_z_nancheck( n-1, duf, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -15;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_z_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_z_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_zgtsv_work( matrix_layout, n, nrhs, dl, d, du, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -14;
- }
- if( LAPACKE_z_nancheck( n, d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_z_nancheck( n, df, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -14;
}
- }
- if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_z_nancheck( n-1, dlf, 1 ) ) {
- return -9;
+ if( LAPACKE_z_nancheck( n, d, 1 ) ) {
+ return -7;
}
- }
- if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
- return -8;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_z_nancheck( n, df, 1 ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_z_nancheck( n-1, duf, 1 ) ) {
- return -11;
+ if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_z_nancheck( n-1, dlf, 1 ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) {
+ return -12;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_z_nancheck( n-1, duf, 1 ) ) {
+ return -11;
+ }
}
}
#endif
lapack_complex_double* du2, lapack_int* ipiv )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_z_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
- return -2;
- }
- if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_z_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zgttrf_work( n, dl, d, du, du2, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_z_nancheck( n, d, 1 ) ) {
- return -6;
- }
- if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
- return -7;
- }
- if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_z_nancheck( n, d, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_zgttrs_work( matrix_layout, trans, n, nrhs, dl, d, du, du2,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -7;
+ }
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -18;
- }
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -15;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -18;
+ }
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -15;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_lsame( vect, 'u' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( vect, 'u' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zhecon_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
{
lapack_int info = 0;
lapack_complex_double* work = NULL;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zhecon_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zheevr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
+ lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 :
+ ( LAPACKE_lsame( range, 'a' ) ||
+ LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int lda_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -12;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -9;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -9;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zheevx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
- LAPACKE_lsame( range, 'v' ) ) ? n :
+ lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 :
+ ( LAPACKE_lsame( range, 'a' ) ||
+ LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int lda_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_zhegst_work( matrix_layout, itype, uplo, n, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -15;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -12;
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -12;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zhegvx
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zhesv_aa_2stage
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zhesv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ lapack_complex_double* work = NULL;
+ lapack_complex_double work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_zhesv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = LAPACK_Z2INT( work_query );
+ /* Allocate memory for work arrays */
+ work = (lapack_complex_double*)
+ LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_zhesv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zhesv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zhesv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb,
+ lapack_complex_double* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_zhesv_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_double* a_t = NULL;
+ lapack_complex_double* tb_t = NULL;
+ lapack_complex_double* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_zhesv_aa_2stage( &uplo, &n, &nrhs, a, &lda_t,
+ tb, <b, ipiv, ipiv2, b, &ldb_t, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_zhesv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zhesv_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n, e, 1) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -24;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -24;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zheswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zhetrf_aa_2stage
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zhetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ lapack_complex_double* work = NULL;
+ lapack_complex_double work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_zhetrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = LAPACK_Z2INT( work_query );
+ /* Allocate memory for work arrays */
+ work = (lapack_complex_double*)
+ LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_zhetrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zhetrf_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zhetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_zhetrf_aa_2stage( &uplo, &n, a, &lda, tb,
+ <b, ipiv, ipiv2, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_double* a_t = NULL;
+ lapack_complex_double* tb_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_zhetrf_aa_2stage( &uplo, &n, a, &lda_t,
+ tb, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ /* Transpose input matrices */
+ LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_zhetrf_aa_2stage( &uplo, &n, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ /* Release memory and exit */
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zhetrf_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zhetrf_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int LAPACKE_zhetrf_rk_work( int matrix_layout, char uplo, lapack_int n,
lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* e,
+ lapack_complex_double* e,
lapack_int* ipiv, lapack_complex_double* work,
lapack_int lwork )
{
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zhetri_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
lapack_complex_double* work = NULL;
lapack_complex_double work_query;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zhetri_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_zhetrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zhetrs_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n, e ,1 ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( n, e ,1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_zhetrs_3_work( matrix_layout, uplo, n, nrhs, a, lda,
- e, ipiv, b, ldb );
+ e, ipiv, b, ldb );
}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zhetrs_aa_2stage
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zhetrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a,
+ lapack_int lda, lapack_complex_double* tb,
+ lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Call middle-level interface */
+ info = LAPACKE_zhetrs_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb);
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zhetrs_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_zhetrs_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_double* a_t = NULL;
+ lapack_complex_double* tb_t = NULL;
+ lapack_complex_double* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_zhetrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info );
+ }
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_zhetrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
- na = LAPACKE_lsame( trans, 'n' ) ? n : k;
- if( LAPACKE_zge_nancheck( matrix_layout, na, ka, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) {
- return -10;
- }
- if( LAPACKE_zpf_nancheck( n, c ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
+ na = LAPACKE_lsame( trans, 'n' ) ? n : k;
+ if( LAPACKE_zge_nancheck( matrix_layout, na, ka, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) {
+ return -10;
+ }
+ if( LAPACKE_zpf_nancheck( n, c ) ) {
+ return -11;
+ }
}
#endif
return LAPACKE_zhfrk_work( matrix_layout, transr, uplo, trans, n, k, alpha,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -8;
- }
- if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -14;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -8;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -10;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -16;
+ if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -14;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -16;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zhp_nancheck( n, bp ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zhp_nancheck( n, bp ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_zhpgst_work( matrix_layout, itype, uplo, n, ap, bp );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_zhp_nancheck( n, bp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_zhp_nancheck( n, bp ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_zhp_nancheck( n, bp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_zhp_nancheck( n, bp ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -13;
- }
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -7;
- }
- if( LAPACKE_zhp_nancheck( n, bp ) ) {
- return -8;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -13;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -10;
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_zhp_nancheck( n, bp ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_zhpsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zhp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zhp_nancheck( n, afp ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zhptrd_work( matrix_layout, uplo, n, ap, d, e, tau );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zhptrf_work( matrix_layout, uplo, n, ap, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_zhptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -7;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
+ }
+ if( LAPACKE_z_nancheck( n, w, 1 ) ) {
+ return -9;
}
- }
- if( LAPACKE_z_nancheck( n, w, 1 ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, h, ldh ) ) {
- return -7;
- }
- if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, h, ldh ) ) {
+ return -7;
+ }
+ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -10;
+ }
}
}
#endif
lapack_int incx )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_z_nancheck( 1+(n-1)*ABS(incx), x, incx ) ) {
- return -2;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_z_nancheck( 1+(n-1)*ABS(incx), x, incx ) ) {
+ return -2;
+ }
}
#endif
return LAPACKE_zlacgv_work( n, x, incx );
double* est, lapack_int* kase, lapack_int* isave )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, est, 1 ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n, x, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, est, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( n, x, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_zlacn2_work( n, v, x, est, kase, isave );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zlacp2_work( matrix_layout, uplo, m, n, a, lda, b, ldb );
* Generated January, 2013
*****************************************************************************/
-#include "lapacke.h"
#include "lapacke_utils.h"
lapack_int LAPACKE_zlacp2_work( int matrix_layout, char uplo, lapack_int m,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zlacpy_work( matrix_layout, uplo, m, n, a, lda, b, ldb );
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zlacrm
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zlacrm(int matrix_layout, lapack_int m,
+ lapack_int n, const lapack_complex_double* a,
+ lapack_int lda, const double* b, lapack_int ldb,
+ lapack_complex_double* c, lapack_int ldc)
+{
+ lapack_int info = 0;
+ double* rwork = NULL;
+
+ if (matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR) {
+ LAPACKE_xerbla("LAPACKE_zlacrm", -1);
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if ( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -6;
+ }
+ }
+#endif
+ /* Allocate memory for work array(s) */
+ rwork = (double*)
+ LAPACKE_malloc(sizeof(double) * MAX(1, 2 * m * n));
+ if (rwork == NULL) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_zlacrm_work(matrix_layout, m, n, a, lda, b, ldb,
+ c, ldc, rwork);
+ /* Release memory and exit */
+ LAPACKE_free(rwork);
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zlacrm", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zlacrm
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zlacrm_work(int matrix_layout, lapack_int m, lapack_int n,
+ const lapack_complex_double* a, lapack_int lda,
+ const double* b, lapack_int ldb,
+ lapack_complex_double* c, lapack_int ldc,
+ double* rwork)
+{
+ lapack_int info = 0;
+ if (matrix_layout == LAPACK_COL_MAJOR) {
+ /* Call LAPACK function */
+ LAPACK_zlacrm(&m, &n, a, &lda, b, &ldb, c, &ldc, rwork);
+ } else if (matrix_layout == LAPACK_ROW_MAJOR) {
+ lapack_int lda_t = MAX(1,m);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_int ldc_t = MAX(1,m);
+ lapack_complex_double* a_t = NULL;
+ double* b_t = NULL;
+ lapack_complex_double* c_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -5;
+ LAPACKE_xerbla( "LAPACKE_zlacrm_work", info );
+ return info;
+ }
+ if( ldb < n ) {
+ info = -7;
+ LAPACKE_xerbla( "LAPACKE_zlacrm_work", info );
+ return info;
+ }
+ if( ldc < n ) {
+ info = -9;
+ LAPACKE_xerbla( "LAPACKE_zlacrm_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_double*)
+ LAPACKE_malloc(sizeof(lapack_complex_double) * lda_t * MAX(1,n));
+ b_t = (double*)
+ LAPACKE_malloc(sizeof(double) * ldb_t * MAX(1,n));
+ c_t = (lapack_complex_double*)
+ LAPACKE_malloc((sizeof(lapack_complex_double) * ldc_t * MAX(1,n)));
+ if (a_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ if (b_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ if (c_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_zge_trans(matrix_layout, m, n, a, lda, a_t, lda_t);
+ LAPACKE_dge_trans(matrix_layout, n, n, b, ldb, b_t, ldb_t);
+ /* Call LAPACK function */
+ LAPACK_zlacrm(&m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, rwork);
+ /* Transpose output matrices */
+ LAPACKE_zge_trans(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc);
+ /* Release memory and exit */
+ LAPACKE_free(c_t);
+exit_level_2:
+ LAPACKE_free(b_t);
+exit_level_1:
+ LAPACKE_free(a_t);
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zlacrm_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla("LAPACKE_zlacrm_work", -1);
+ }
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zlag2c_work( matrix_layout, m, n, a, lda, sa, ldsa );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zlange
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lda )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
double* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zlange", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zlange
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lda, double* work )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
+ char norm_lapack;
if( matrix_layout == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
+ /* Call LAPACK function */
res = LAPACK_zlange( &norm, &m, &n, a, &lda, work );
- if( info < 0 ) {
- info = info - 1;
- }
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int lda_t = MAX(1,m);
- lapack_complex_double* a_t = NULL;
+ double* work_lapack = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_zlange_work", info );
return info;
}
- /* Allocate memory for temporary array(s) */
- a_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
- if( a_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
+ if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
+ norm_lapack = 'i';
+ } else if( LAPACKE_lsame( norm, 'i' ) ) {
+ norm_lapack = '1';
+ } else {
+ norm_lapack = norm;
+ }
+ /* Allocate memory for work array(s) */
+ if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
+ work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
+ if( work_lapack == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
}
- /* Transpose input matrices */
- LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
- /* Call LAPACK function and adjust info */
- res = LAPACK_zlange( &norm, &m, &n, a_t, &lda_t, work );
- info = 0; /* LAPACK call is ok! */
+ /* Call LAPACK function */
+ res = LAPACK_zlange( &norm_lapack, &n, &m, a, &lda, work_lapack );
/* Release memory and exit */
- LAPACKE_free( a_t );
+ if( work_lapack ) {
+ LAPACKE_free( work_lapack );
+ }
exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zlange_work", info );
}
} else {
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zlanhe
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
const lapack_complex_double* a, lapack_int lda )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
double* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zlanhe", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zlanhe
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lda, double* work )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
res = LAPACK_zlanhe( &norm, &uplo, &n, a, &lda, work );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zlansy
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
const lapack_complex_double* a, lapack_int lda )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
double* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zlansy", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zlansy
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lda, double* work )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
res = LAPACK_zlansy( &norm, &uplo, &n, a, &lda, work );
const lapack_complex_double* a, lapack_int lda )
{
lapack_int info = 0;
- double res = 0.;
+ double res = 0.;
double* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zlantr", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zlapmr_work( matrix_layout, forwrd, m, n, x, ldx, k );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zlapmt_work( matrix_layout, forwrd, m, n, x, ldx, k );
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zlarcm
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zlarcm(int matrix_layout, lapack_int m,
+ lapack_int n, const double* a, lapack_int lda,
+ const lapack_complex_double* b, lapack_int ldb,
+ lapack_complex_double* c, lapack_int ldc)
+{
+ lapack_int info = 0;
+ double* rwork = NULL;
+
+ if (matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR) {
+ LAPACKE_xerbla("LAPACKE_zlarcm", -1);
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if ( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_dge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -6;
+ }
+ }
+#endif
+ /* Allocate memory for work array(s) */
+ rwork = (double*)
+ LAPACKE_malloc(sizeof(double) * MAX(1, 2 * m * n));
+ if (rwork == NULL) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_zlarcm_work(matrix_layout, m, n, a, lda, b, ldb,
+ c, ldc, rwork);
+ /* Release memory and exit */
+ LAPACKE_free(rwork);
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zlarcm", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zlarcm
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zlarcm_work(int matrix_layout, lapack_int m, lapack_int n,
+ const double* a, lapack_int lda,
+ const lapack_complex_double* b, lapack_int ldb,
+ lapack_complex_double* c, lapack_int ldc,
+ double* rwork)
+{
+ lapack_int info = 0;
+ if (matrix_layout == LAPACK_COL_MAJOR) {
+ /* Call LAPACK function */
+ LAPACK_zlarcm(&m, &n, a, &lda, b, &ldb, c, &ldc, rwork);
+ } else if (matrix_layout == LAPACK_ROW_MAJOR) {
+ lapack_int lda_t = MAX(1,m);
+ lapack_int ldb_t = MAX(1,m);
+ lapack_int ldc_t = MAX(1,m);
+ double* a_t = NULL;
+ lapack_complex_double* b_t = NULL;
+ lapack_complex_double* c_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < m ) {
+ info = -5;
+ LAPACKE_xerbla( "LAPACKE_zlarcm_work", info );
+ return info;
+ }
+ if( ldb < n ) {
+ info = -7;
+ LAPACKE_xerbla( "LAPACKE_zlarcm_work", info );
+ return info;
+ }
+ if( ldc < n ) {
+ info = -9;
+ LAPACKE_xerbla( "LAPACKE_zlarcm_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (double*)
+ LAPACKE_malloc(sizeof(double) * lda_t * MAX(1,m));
+ b_t = (lapack_complex_double*)
+ LAPACKE_malloc(sizeof(lapack_complex_double) * ldb_t * MAX(1,n));
+ c_t = (lapack_complex_double*)
+ LAPACKE_malloc((sizeof(lapack_complex_double) * ldc_t * MAX(1,n)));
+ if (a_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ if (b_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ if (c_t == NULL) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_dge_trans(matrix_layout, m, m, a, lda, a_t, lda_t);
+ LAPACKE_zge_trans(matrix_layout, m, n, b, ldb, b_t, ldb_t);
+ /* Call LAPACK function */
+ LAPACK_zlarcm(&m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, rwork);
+ /* Transpose output matrices */
+ LAPACKE_zge_trans(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc);
+ /* Release memory and exit */
+ LAPACKE_free(c_t);
+exit_level_2:
+ LAPACKE_free(b_t);
+exit_level_1:
+ LAPACKE_free(a_t);
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zlarcm_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla("LAPACKE_zlarcm_work", -1);
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zlarfb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int ldc )
{
lapack_int info = 0;
- lapack_int ldwork = ( side=='l')?n:(( side=='r')?m:1);
+ lapack_int ldwork;
lapack_complex_double* work = NULL;
lapack_int ncols_v, nrows_v;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'r' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
- nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'l' ) ) ? m :
- ( ( LAPACKE_lsame( storev, 'c' ) &&
- LAPACKE_lsame( side, 'r' ) ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -13;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, k, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_ztr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
- if( k > nrows_v ) {
- LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
+ ( ( LAPACKE_lsame( storev, 'r' ) &&
+ LAPACKE_lsame( side, 'l' ) ) ? m :
+ ( ( LAPACKE_lsame( storev, 'r' ) &&
+ LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+ nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
+ LAPACKE_lsame( side, 'l' ) ) ? m :
+ ( ( LAPACKE_lsame( storev, 'c' ) &&
+ LAPACKE_lsame( side, 'r' ) ) ? n :
+ ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -13;
}
- if( LAPACKE_ztr_nancheck( matrix_layout, 'u', 'u', k,
- &v[(nrows_v-k)*ldv], ldv ) )
- return -9;
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( LAPACKE_ztr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
- return -9;
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
- ldv ) )
- return -9;
- } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
- if( k > ncols_v ) {
- LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
- return -8;
+ if( LAPACKE_zge_nancheck( matrix_layout, k, k, t, ldt ) ) {
+ return -11;
+ }
+ if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( LAPACKE_ztr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
+ return -9;
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
+ ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
+ if( k > nrows_v ) {
+ LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
+ return -8;
+ }
+ if( LAPACKE_ztr_nancheck( matrix_layout, 'u', 'u', k,
+ &v[(nrows_v-k)*ldv], ldv ) )
+ return -9;
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( LAPACKE_ztr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
+ return -9;
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
+ ldv ) )
+ return -9;
+ } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
+ if( k > ncols_v ) {
+ LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
+ return -8;
+ }
+ if( LAPACKE_ztr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
+ ldv ) )
+ return -9;
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
+ return -9;
}
- if( LAPACKE_ztr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
- ldv ) )
- return -9;
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
- return -9;
}
#endif
+ if( LAPACKE_lsame( side, 'l' ) ) {
+ ldwork = n;
+ } else if( LAPACKE_lsame( side, 'r' ) ) {
+ ldwork = m;
+ } else {
+ ldwork = 1;
+ }
/* Allocate memory for working array(s) */
work = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldwork * MAX(1,k) );
lapack_complex_double* tau )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_z_nancheck( 1, alpha, 1 ) ) {
- return -2;
- }
- if( LAPACKE_z_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_z_nancheck( 1, alpha, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_z_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_zlarfg_work( n, alpha, x, incx, tau );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
- ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
- nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
- ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
+ ( LAPACKE_lsame( storev, 'r' ) ? n : 1);
+ nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
+ ( LAPACKE_lsame( storev, 'r' ) ? k : 1);
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_zlarft_work( matrix_layout, direct, storev, n, k, v, ldv, tau,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -7;
- }
- if( LAPACKE_z_nancheck( 1, &tau, 1 ) ) {
- return -6;
- }
- if( LAPACKE_z_nancheck( m, v, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -7;
+ }
+ if( LAPACKE_z_nancheck( 1, &tau, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_z_nancheck( m, v, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zlarfx_work( matrix_layout, side, m, n, v, tau, c, ldc,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- switch (type) {
- case 'G':
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ switch (type) {
+ case 'G':
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'L':
+ // TYPE = 'L' - lower triangle of general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_zgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
+ return -9;
+ }
+ break;
+ case 'U':
+ // TYPE = 'U' - upper triangle of general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_zgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
+ return -9;
+ }
+ break;
+ case 'H':
+ // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_zgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
+ return -9;
+ }
+ case 'B':
+ // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
+ if( LAPACKE_zhb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'Q':
+ // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
+ if( LAPACKE_zhb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
+ return -9;
+ }
+ break;
+ case 'Z':
+ // TYPE = 'Z' - band matrix laid out for ?GBTRF
+ if( matrix_layout == LAPACK_COL_MAJOR &&
+ LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
+ return -9;
+ }
+ if( matrix_layout == LAPACK_ROW_MAJOR &&
+ LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
+ return -9;
+ }
+ break;
}
- break;
- case 'L':
- // TYPE = 'L' - lower triangle of general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_zgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
- return -9;
- }
- break;
- case 'U':
- // TYPE = 'U' - upper triangle of general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_zgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
- return -9;
- }
- break;
- case 'H':
- // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_zgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
- return -9;
- }
- case 'B':
- // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
- if( LAPACKE_zhb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
- return -9;
- }
- break;
- case 'Q':
- // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
- if( LAPACKE_zhb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
- return -9;
- }
- break;
- case 'Z':
- // TYPE = 'Z' - band matrix laid out for ?GBTRF
- if( matrix_layout == LAPACK_COL_MAJOR &&
- LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
- return -9;
- }
- if( matrix_layout == LAPACK_ROW_MAJOR &&
- LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
- return -9;
- }
- break;
}
#endif
return LAPACKE_zlascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda );
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_z_nancheck( 1, &alpha, 1 ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( 1, &beta, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_z_nancheck( 1, &alpha, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( 1, &beta, 1 ) ) {
+ return -6;
+ }
}
#endif
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zlassq
+* Author: Julien langou
+* Generated February 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zlassq( lapack_int n, lapack_complex_double* x,
+ lapack_int incx, double* scale, double* sumsq )
+{
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input vector `x` and in/out scalars `scale` and `sumsq` for NaNs */
+ if( LAPACKE_z_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
+ return -2;
+ }
+ if( LAPACKE_d_nancheck( 1, scale, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, sumsq, 1 ) ) {
+ return -5;
+ }
+ }
+#endif
+ return LAPACKE_zlassq_work( n, x, incx, scale, sumsq );
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2017, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zlassq
+* Author: Julien Langou
+* Generated February, 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zlassq_work( lapack_int n, lapack_complex_double* x,
+ lapack_int incx, double* scale, double* sumsq )
+{
+ lapack_int info = 0;
+ LAPACK_zlassq( &n, x, &incx, scale, sumsq );
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
-/*****************************************************************************
-* Disable the check as is below, the check below was checking for NaN
-* from lda to n since there is no (obvious) way to knowing m. This is not
-* a good idea. We could get a lower bound of m by scanning from ipiv. Or
-* we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable
-* the buggy Nan check.
-* See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827
-*****************************************************************************/
-/* if( LAPACKE_zge_nancheck( matrix_layout, lda, n, a, lda ) ) {
-* return -3;
-* }
-*/
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ /*****************************************************************************
+ * Disable the check as is below, the check below was checking for NaN
+ * from lda to n since there is no (obvious) way to knowing m. This is not
+ * a good idea. We could get a lower bound of m by scanning from ipiv. Or
+ * we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable
+ * the buggy Nan check.
+ * See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827
+ *****************************************************************************/
+ /* if( LAPACKE_zge_nancheck( matrix_layout, lda, n, a, lda ) ) {
+ * return -3;
+ * }
+ */
+ }
#endif
return LAPACKE_zlaswp_work( matrix_layout, n, a, lda, k1, k2, ipiv, incx );
}
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zlaswp
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_d_nancheck( 1, &cond, 1 ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( MIN(n,m), d, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &dmax, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -14;
+ }
+ if( LAPACKE_d_nancheck( 1, &cond, 1 ) ) {
+ return -9;
+ }
+ if( LAPACKE_d_nancheck( MIN(n,m), d, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &dmax, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zlauum_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zpbequ_work( matrix_layout, uplo, n, kd, ab, ldab, s, scond,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zpbstf_work( matrix_layout, uplo, n, kb, bb, ldbb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_zpbsv_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -7;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -7;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) {
+ return -9;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zpbtrf_work( matrix_layout, uplo, n, kd, ab, ldab );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_zpbtrs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpf_nancheck( n, a ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpf_nancheck( n, a ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zpftrf_work( matrix_layout, transr, uplo, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpf_nancheck( n, a ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpf_nancheck( n, a ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zpftri_work( matrix_layout, transr, uplo, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpf_nancheck( n, a ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpf_nancheck( n, a ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_zpftrs_work( matrix_layout, transr, uplo, n, nrhs, a, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_zpoequ_work( matrix_layout, n, a, lda, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_zpoequb_work( matrix_layout, n, a, lda, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -21;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -10;
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -21;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -13;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -13;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_zposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -23;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -23;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zpotrf_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zpotrf2_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zpotri_work( matrix_layout, uplo, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_zpotrs_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -5;
- }
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zppequ_work( matrix_layout, uplo, n, ap, s, scond, amax );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_zppsv_work( matrix_layout, uplo, n, nrhs, ap, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zpp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zpp_nancheck( n, afp ) ) {
+ return -7;
+ }
}
- }
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -9;
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -9;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zpptrf_work( matrix_layout, uplo, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zpptri_work( matrix_layout, uplo, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_zpptrs_work( matrix_layout, uplo, n, nrhs, ap, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &tol, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, &tol, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
lapack_int info = 0;
double* work = NULL;
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -7;
- }
- if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_z_nancheck( n-1, ef, 1 ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n, df, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_z_nancheck( n-1, ef, 1 ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zptsv_work( matrix_layout, n, nrhs, d, e, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n, df, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_z_nancheck( n-1, ef, 1 ) ) {
- return -8;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n, df, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_z_nancheck( n-1, ef, 1 ) ) {
+ return -8;
+ }
}
}
#endif
lapack_int LAPACKE_zpttrf( lapack_int n, double* d, lapack_complex_double* e )
{
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -2;
- }
- if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
- return -3;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -2;
+ }
+ if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
+ return -3;
+ }
}
#endif
return LAPACKE_zpttrf_work( n, d, e );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_zpttrs_work( matrix_layout, uplo, n, nrhs, d, e, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -6;
- }
- if( LAPACKE_zsp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_zsp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsp_nancheck( n, afp ) ) {
- return -6;
- }
- if( LAPACKE_zsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsp_nancheck( n, afp ) ) {
+ return -6;
+ }
+ if( LAPACKE_zsp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_zspsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zsp_nancheck( n, afp ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zsp_nancheck( n, afp ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_zsp_nancheck( n, ap ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
}
- }
- if( LAPACKE_zsp_nancheck( n, ap ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zsptrf_work( matrix_layout, uplo, n, ap, ipiv );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsp_nancheck( n, ap ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsp_nancheck( n, ap ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -7;
+ }
}
#endif
return LAPACKE_zsptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zstegr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
- return -11;
- }
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
+ return -11;
}
- }
- if( LAPACKE_lsame( range, 'v' ) ) {
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ }
+ if( LAPACKE_lsame( range, 'v' ) ) {
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
}
#endif
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zstein
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -3;
- }
- if( LAPACKE_d_nancheck( n, e, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n, w, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -3;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n, w, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -5;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
- return -7;
- }
- if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zstemr
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int ldz_t = MAX(1,n);
lapack_complex_double* z_t = NULL;
/* Check leading dimension(s) */
- if( ldz < n ) {
+ if( ldz < 1 || ( LAPACKE_lsame( jobz, 'v' ) && ldz < n ) ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_zstemr_work", info );
return info;
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_d_nancheck( n, d, 1 ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
- return -5;
- }
- if( LAPACKE_lsame( compz, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_d_nancheck( n, d, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
+ return -5;
+ }
+ if( LAPACKE_lsame( compz, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -6;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zsycon_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
{
lapack_int info = 0;
lapack_complex_double* work = NULL;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zsycon_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n, e, 1 ) ) {
- return -6;
- }
- if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
+ if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
/* Call middle-level interface */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_z_nancheck( 1, &alpha, 1 ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n, x, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_z_nancheck( 1, &alpha, 1 ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n, x, 1 ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_zsyr_work( matrix_layout, uplo, n, alpha, x, incx, a,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -12;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( equed, 'y' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -11;
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -12;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_lsame( equed, 'y' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -11;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -14;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -14;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zsysv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ lapack_complex_double* work = NULL;
+ lapack_complex_double work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_zsysv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = LAPACK_Z2INT( work_query );
+ /* Allocate memory for work arrays */
+ work = (lapack_complex_double*)
+ LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_zsysv_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb, work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zsysv_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb,
+ lapack_complex_double* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_zsysv_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_double* a_t = NULL;
+ lapack_complex_double* tb_t = NULL;
+ lapack_complex_double* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_zsysv_aa_2stage( &uplo, &n, &nrhs, a, &lda_t,
+ tb, <b, ipiv, ipiv2, b, &ldb_t, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_zsysv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zsysv_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n, e, 1) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -11;
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -13;
- }
- if( nparams>0 ) {
- if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
- return -24;
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
+ return -8;
+ }
}
- }
- if( LAPACKE_lsame( fact, 'f' ) ) {
- if( LAPACKE_d_nancheck( n, s, 1 ) ) {
- return -12;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -13;
+ }
+ if( nparams>0 ) {
+ if( LAPACKE_d_nancheck( nparams, params, 1 ) ) {
+ return -24;
+ }
+ }
+ if( LAPACKE_lsame( fact, 'f' ) ) {
+ if( LAPACKE_d_nancheck( n, s, 1 ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_zsyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zsytrf_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2 )
+{
+ lapack_int info = 0;
+ lapack_int lwork = -1;
+ lapack_complex_double* work = NULL;
+ lapack_complex_double work_query;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ }
+#endif
+ /* Query optimal working array(s) size */
+ info = LAPACKE_zsytrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ &work_query, lwork );
+ if( info != 0 ) {
+ goto exit_level_0;
+ }
+ lwork = LAPACK_Z2INT( work_query );
+ /* Allocate memory for work arrays */
+ work = (lapack_complex_double*)
+ LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
+ if( work == NULL ) {
+ info = LAPACK_WORK_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ /* Call middle-level interface */
+ info = LAPACKE_zsytrf_aa_2stage_work( matrix_layout, uplo, n,
+ a, lda, tb, ltb, ipiv, ipiv2,
+ work, lwork );
+ /* Release memory and exit */
+ LAPACKE_free( work );
+exit_level_0:
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage", info );
+ }
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zsytrf_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* tb, lapack_int ltb,
+ lapack_int* ipiv, lapack_int* ipiv2,
+ lapack_complex_double* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_zsytrf_aa_2stage( &uplo, &n, a, &lda, tb,
+ <b, ipiv, ipiv2, work, &lwork,
+ &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_double* a_t = NULL;
+ lapack_complex_double* tb_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage_work", info );
+ return info;
+ }
+ /* Query optimal working array(s) size if requested */
+ if( lwork == -1 ) {
+ LAPACK_zsytrf_aa_2stage( &uplo, &n, a, &lda_t,
+ tb, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ return (info < 0) ? (info - 1) : info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ /* Transpose input matrices */
+ LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_zsytrf_aa_2stage( &uplo, &n, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, work,
+ &lwork, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ /* Release memory and exit */
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage_work", info );
+ }
+ return info;
+}
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zsytrf_rk
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zsytri_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
lapack_complex_double* work = NULL;
lapack_complex_double work_query;
+ lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zsytri_3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n, e, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n-1, e + e_start, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_zsytrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zsytrs_3
* Author: Intel Corporation
-* Generated December 2016
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n, e ,1 ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( n, e ,1 ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_zsytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda,
- e, ipiv, b, ldb );
+ e, ipiv, b, ldb );
}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native high-level C interface to LAPACK function zsytrs_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
+ LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage", -1 );
+ return -1;
+ }
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -11;
+ }
+ }
+#endif
+ /* Call middle-level interface */
+ info = LAPACKE_zsytrs_aa_2stage_work( matrix_layout, uplo, n, nrhs,
+ a, lda, tb, ltb, ipiv, ipiv2, b,
+ ldb );
+ return info;
+}
--- /dev/null
+/*****************************************************************************
+ Copyright (c) 2014, Intel Corp.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of Intel Corporation nor the names of its contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+ THE POSSIBILITY OF SUCH DAMAGE.
+*****************************************************************************
+* Contents: Native middle-level C interface to LAPACK function zsytrs_aa
+* Author: Intel Corporation
+* Generated November 2017
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+lapack_int LAPACKE_zsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n,
+ lapack_int nrhs, lapack_complex_double* a, lapack_int lda,
+ lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv,
+ lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* Call LAPACK function and adjust info */
+ LAPACK_zsytrs_aa_2stage( &uplo, &n, &nrhs, a, &lda, tb,
+ <b, ipiv, ipiv2, b, &ldb, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+ lapack_int lda_t = MAX(1,n);
+ lapack_int ldb_t = MAX(1,n);
+ lapack_complex_double* a_t = NULL;
+ lapack_complex_double* tb_t = NULL;
+ lapack_complex_double* b_t = NULL;
+ /* Check leading dimension(s) */
+ if( lda < n ) {
+ info = -6;
+ LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ltb < 4*n ) {
+ info = -8;
+ LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info );
+ return info;
+ }
+ if( ldb < nrhs ) {
+ info = -12;
+ LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info );
+ return info;
+ }
+ /* Allocate memory for temporary array(s) */
+ a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
+ if( a_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_0;
+ }
+ tb_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ltb );
+ if( tb_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_1;
+ }
+ b_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,nrhs) );
+ if( b_t == NULL ) {
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
+ goto exit_level_2;
+ }
+ /* Transpose input matrices */
+ LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
+ LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
+ /* Call LAPACK function and adjust info */
+ LAPACK_zsytrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t,
+ tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info );
+ if( info < 0 ) {
+ info = info - 1;
+ }
+ /* Transpose output matrices */
+ LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
+ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
+ /* Release memory and exit */
+ LAPACKE_free( b_t );
+exit_level_2:
+ LAPACKE_free( tb_t );
+exit_level_1:
+ LAPACKE_free( a_t );
+exit_level_0:
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
+ LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info );
+ }
+ } else {
+ info = -1;
+ LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info );
+ }
+ return info;
+}
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_zsytrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -7;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -12;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -12;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -10;
+ }
}
#endif
return LAPACKE_ztbtrs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( IS_Z_NONZERO(alpha) ) {
- if( LAPACKE_ztf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( IS_Z_NONZERO(alpha) ) {
+ if( LAPACKE_ztf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
+ return -10;
+ }
}
- }
- if( LAPACKE_z_nancheck( 1, &alpha, 1 ) ) {
- return -9;
- }
- if( IS_Z_NONZERO(alpha) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -11;
+ if( LAPACKE_z_nancheck( 1, &alpha, 1 ) ) {
+ return -9;
+ }
+ if( IS_Z_NONZERO(alpha) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_ztftri_work( matrix_layout, transr, uplo, diag, n, a );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpf_nancheck( n, arf ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpf_nancheck( n, arf ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ztfttp_work( matrix_layout, transr, uplo, n, arf, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpf_nancheck( n, arf ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpf_nancheck( n, arf ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ztfttr_work( matrix_layout, transr, uplo, n, arf, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, p, ldp ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, s, lds ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, p, ldp ) ) {
+ return -8;
}
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, s, lds ) ) {
+ return -6;
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -7;
- }
- if( wantq ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
}
- }
- if( wantz ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -11;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -7;
+ }
+ if( wantq ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -9;
+ }
+ }
+ if( wantz ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -11;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( wantq ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -13;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -7;
}
- }
- if( wantz ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
- return -15;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( wantq ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -13;
+ }
+ }
+ if( wantz ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
+ return -15;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
- return -12;
- }
- if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -22;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -10;
}
- }
- if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
- return -14;
- }
- if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
- return -15;
- }
- if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, m, m, u, ldu ) ) {
- return -18;
+ if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) {
+ return -12;
}
- }
- if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, p, p, v, ldv ) ) {
- return -20;
+ if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -22;
+ }
+ }
+ if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) {
+ return -14;
+ }
+ if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) {
+ return -15;
+ }
+ if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, m, m, u, ldu ) ) {
+ return -18;
+ }
+ }
+ if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, p, p, v, ldv ) ) {
+ return -20;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -12;
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -10;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -12;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, m, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, m, d, ldd ) ) {
- return -12;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, e, lde ) ) {
- return -14;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, f, ldf ) ) {
- return -16;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, m, d, ldd ) ) {
+ return -12;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, e, lde ) ) {
+ return -14;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, f, ldf ) ) {
+ return -16;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- ncols_a = LAPACKE_lsame( side, 'L' ) ? n :
- ( LAPACKE_lsame( side, 'R' ) ? k : 0 );
- nrows_a = LAPACKE_lsame( side, 'L' ) ? k :
- ( LAPACKE_lsame( side, 'R' ) ? m : 0 );
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) {
- return -13;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -15;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
- return -11;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ ncols_a = LAPACKE_lsame( side, 'L' ) ? n :
+ ( LAPACKE_lsame( side, 'R' ) ? k : 0 );
+ nrows_a = LAPACKE_lsame( side, 'L' ) ? k :
+ ( LAPACKE_lsame( side, 'R' ) ? m : 0 );
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_a, ncols_a, a, lda ) ) {
+ return -13;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -15;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, nb, k, t, ldt ) ) {
+ return -11;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) {
+ return -9;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -8;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -6;
+ }
}
#endif
return LAPACKE_ztpqrt2_work( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( storev, 'C' ) ) {
- ncols_v = k;
- nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- } else if( LAPACKE_lsame( storev, 'R' ) ) {
- ncols_v = LAPACKE_lsame( side, 'L' ) ? m :
- ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
- nrows_v = k;
- } else {
- ncols_v = 0;
- nrows_v = 0;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -14;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
- return -16;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, k, k, t, ldt ) ) {
- return -12;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( storev, 'C' ) ) {
+ ncols_v = k;
+ nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ } else if( LAPACKE_lsame( storev, 'R' ) ) {
+ ncols_v = LAPACKE_lsame( side, 'L' ) ? m :
+ ( LAPACKE_lsame( side, 'R' ) ? n : 0 );
+ nrows_v = k;
+ } else {
+ ncols_v = 0;
+ nrows_v = 0;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -14;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) {
+ return -16;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, k, k, t, ldt ) ) {
+ return -12;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
+ return -10;
+ }
}
#endif
if (side=='l' || side=='L') {
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -10;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ztptri_work( matrix_layout, uplo, diag, n, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -8;
+ }
}
#endif
return LAPACKE_ztptrs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ztpttf_work( matrix_layout, transr, uplo, n, ap, arf );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_ztpttr_work( matrix_layout, uplo, n, ap, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -6;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -10;
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -6;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -4;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -4;
}
#endif
return LAPACKE_ztrexc_work( matrix_layout, compq, n, t, ldt, q, ldq, ifst,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) {
+ return -11;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_lsame( compq, 'v' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_lsame( compq, 'v' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
- return -6;
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) {
+ return -6;
}
- }
- if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
- if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
- return -10;
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) {
+ return -8;
+ }
+ }
+ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
+ if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) {
+ return -10;
+ }
}
}
#endif
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
- return -9;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
+ return -9;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
}
#endif
return LAPACKE_ztrsyl_work( matrix_layout, trana, tranb, isgn, m, n, a, lda,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ztrtri_work( matrix_layout, uplo, diag, n, a, lda );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
+ return -9;
+ }
}
#endif
return LAPACKE_ztrtrs_work( matrix_layout, uplo, trans, diag, n, nrhs, a,
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
}
#endif
return LAPACKE_ztrttf_work( matrix_layout, transr, uplo, n, a, lda, arf );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
return LAPACKE_ztrttp_work( matrix_layout, uplo, n, a, lda, ap );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -4;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -4;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zunbdb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int lwork = -1;
lapack_complex_double* work = NULL;
lapack_complex_double work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zunbdb", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) {
- return -9;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -11;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) {
- return -13;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) {
+ return -9;
+ }
+ if( LAPACKE_zge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) {
+ return -11;
+ }
+ if( LAPACKE_zge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) {
+ return -13;
+ }
}
#endif
/* Query optimal working array(s) size */
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zunbdb
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_complex_double* work, lapack_int lwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
+ }
/* Call LAPACK function and adjust info */
- LAPACK_zunbdb( &trans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
+ LAPACK_zunbdb( <rans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
x21, &ldx21, x22, &ldx22, theta, phi, taup1, taup2,
tauq1, tauq2, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- lapack_complex_double* x11_t = NULL;
- lapack_complex_double* x12_t = NULL;
- lapack_complex_double* x21_t = NULL;
- lapack_complex_double* x22_t = NULL;
- /* Check leading dimension(s) */
- if( ldx11 < q ) {
- info = -8;
- LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -10;
- LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lwork == -1 ) {
- LAPACK_zunbdb( &trans, &signs, &m, &p, &q, x11, &ldx11_t, x12,
- &ldx12_t, x21, &ldx21_t, x22, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
- }
- x22_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- /* Transpose input matrices */
- LAPACKE_zge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_zge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_zge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_zge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
- /* Call LAPACK function and adjust info */
- LAPACK_zunbdb( &trans, &signs, &m, &p, &q, x11_t, &ldx11_t, x12_t,
- &ldx12_t, x21_t, &ldx21_t, x22_t, &ldx22_t, theta, phi,
- taup1, taup2, tauq1, tauq2, work, &lwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- /* Transpose output matrices */
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- /* Release memory and exit */
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function zuncsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_complex_double* work = NULL;
double rwork_query;
lapack_complex_double work_query;
- lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
+ int lapack_layout;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zuncsd", -1 );
return -1;
}
-#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -11;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) {
- return -13;
+ if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ lapack_layout = LAPACK_COL_MAJOR;
+ } else {
+ lapack_layout = LAPACK_ROW_MAJOR;
}
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -15;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) {
- return -17;
+#ifndef LAPACK_DISABLE_NAN_CHECK
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) {
+ return -11;
+ }
+ if( LAPACKE_zge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) {
+ return -13;
+ }
+ if( LAPACKE_zge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) {
+ return -15;
+ }
+ if( LAPACKE_zge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) {
+ return -17;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nrows_x11 = p ;
- nrows_x21 = m-p ;
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nrows_x11 = p;
+ nrows_x21 = m-p;
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
+ return -8;
+ }
+
+ if( LAPACKE_zge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
+ return -9;
+ }
}
-
- if( LAPACKE_zge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
- return -9;
- }
-
#endif
/* Allocate memory for working array(s) */
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-MIN(MIN(p,m-p),MIN(q,m-q))) );
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function zuncsd
* Author: Intel Corporation
-* Generated November 2015
+* Generated June 2017
*****************************************************************************/
#include "lapacke_utils.h"
lapack_int* iwork )
{
lapack_int info = 0;
- if( matrix_layout == LAPACK_COL_MAJOR ) {
- /* Call LAPACK function and adjust info */
- LAPACK_zuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22, &ldx22,
- theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t, &ldv2t,
- work, &lwork, rwork, &lrwork, iwork, &info );
- if( info < 0 ) {
- info = info - 1;
- }
- } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
- lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
- lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
- lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
- lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
- lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
- lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
- lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
- lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
- lapack_int ldu1_t = MAX(1,nrows_u1);
- lapack_int ldu2_t = MAX(1,nrows_u2);
- lapack_int ldv1t_t = MAX(1,nrows_v1t);
- lapack_int ldv2t_t = MAX(1,nrows_v2t);
- lapack_int ldx11_t = MAX(1,nrows_x11);
- lapack_int ldx12_t = MAX(1,nrows_x12);
- lapack_int ldx21_t = MAX(1,nrows_x21);
- lapack_int ldx22_t = MAX(1,nrows_x22);
- lapack_complex_double* x11_t = NULL;
- lapack_complex_double* x12_t = NULL;
- lapack_complex_double* x21_t = NULL;
- lapack_complex_double* x22_t = NULL;
- lapack_complex_double* u1_t = NULL;
- lapack_complex_double* u2_t = NULL;
- lapack_complex_double* v1t_t = NULL;
- lapack_complex_double* v2t_t = NULL;
- /* Check leading dimension(s) */
- if( ldu1 < p ) {
- info = -21;
- LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
- return info;
- }
- if( ldu2 < m-p ) {
- info = -23;
- LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
- return info;
- }
- if( ldv1t < q ) {
- info = -25;
- LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
- return info;
- }
- if( ldv2t < m-q ) {
- info = -27;
- LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
- return info;
- }
- if( ldx11 < q ) {
- info = -12;
- LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
- return info;
- }
- if( ldx12 < m-q ) {
- info = -14;
- LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
- return info;
- }
- if( ldx21 < q ) {
- info = -16;
- LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
- return info;
- }
- if( ldx22 < m-q ) {
- info = -18;
- LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
- return info;
- }
- /* Query optimal working array(s) size if requested */
- if( lrwork == -1 || lwork == -1 ) {
- LAPACK_zuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m,
- &p, &q, x11, &ldx11_t, x12, &ldx12_t, x21, &ldx21_t,
- x22, &ldx22_t, theta, u1, &ldu1_t, u2, &ldu2_t, v1t,
- &ldv1t_t, v2t, &ldv2t_t, work, &lwork, rwork,
- &lrwork, iwork, &info );
- return (info < 0) ? (info - 1) : info;
- }
- /* Allocate memory for temporary array(s) */
- x11_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldx11_t * MAX(1,q) );
- if( x11_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_0;
- }
- x12_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldx12_t * MAX(1,m-q) );
- if( x12_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_1;
- }
- x21_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldx21_t * MAX(1,q) );
- if( x21_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_2;
+ /* LAPACK function works with matrices in both layouts. It is supported
+ * through TRANS parameter. So all conversion between layouts can be
+ * completed in LAPACK function. See the table below which describes how
+ * every LAPACKE call is forwarded to corresponding LAPACK call.
+ *
+ * matrix_layout | trans_LAPACKE | -> trans_LAPACK
+ * | (trans) | (ltrans)
+ * -----------------+---------------+----------------
+ * LAPACK_COL_MAJOR | 'N' | -> 'N'
+ * LAPACK_COL_MAJOR | 'T' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'N' | -> 'T'
+ * LAPACK_ROW_MAJOR | 'T' | -> 'T'
+ * (note that for row major layout trans parameter is ignored)
+ */
+ if( matrix_layout == LAPACK_COL_MAJOR ||
+ matrix_layout == LAPACK_ROW_MAJOR ) {
+ char ltrans;
+ if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
+ ltrans = 'n';
+ } else {
+ ltrans = 't';
}
- x22_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldx22_t * MAX(1,m-q) );
- if( x22_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_3;
- }
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- u1_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldu1_t * MAX(1,p) );
- if( u1_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_4;
- }
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- u2_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldu2_t * MAX(1,m-p) );
- if( u2_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_5;
- }
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- v1t_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldv1t_t * MAX(1,q) );
- if( v1t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_6;
- }
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- v2t_t = (lapack_complex_double*)
- LAPACKE_malloc( sizeof(lapack_complex_double) *
- ldv2t_t * MAX(1,m-q) );
- if( v2t_t == NULL ) {
- info = LAPACK_TRANSPOSE_MEMORY_ERROR;
- goto exit_level_7;
- }
- }
- /* Transpose input matrices */
- LAPACKE_zge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
- ldx11_t );
- LAPACKE_zge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
- ldx12_t );
- LAPACKE_zge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
- ldx21_t );
- LAPACKE_zge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
- ldx22_t );
/* Call LAPACK function and adjust info */
- LAPACK_zuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
- &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t,
- x22_t, &ldx22_t, theta, u1_t, &ldu1_t, u2_t, &ldu2_t,
- v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, work, &lwork, rwork,
- &lrwork, iwork, &info );
+ LAPACK_zuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, <rans, &signs, &m,
+ &p, &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22,
+ &ldx22, theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
+ &ldv2t, work, &lwork, rwork, &lrwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
- /* Transpose output matrices */
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
- ldx11 );
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
- x12, ldx12 );
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
- ldx21 );
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
- x22, ldx22 );
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
- ldu1 );
- }
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
- u2, ldu2 );
- }
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
- v1t, ldv1t );
- }
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
- v2t, ldv2t );
- }
- /* Release memory and exit */
- if( LAPACKE_lsame( jobv2t, 'y' ) ) {
- LAPACKE_free( v2t_t );
- }
-exit_level_7:
- if( LAPACKE_lsame( jobv1t, 'y' ) ) {
- LAPACKE_free( v1t_t );
- }
-exit_level_6:
- if( LAPACKE_lsame( jobu2, 'y' ) ) {
- LAPACKE_free( u2_t );
- }
-exit_level_5:
- if( LAPACKE_lsame( jobu1, 'y' ) ) {
- LAPACKE_free( u1_t );
- }
-exit_level_4:
- LAPACKE_free( x22_t );
-exit_level_3:
- LAPACKE_free( x21_t );
-exit_level_2:
- LAPACKE_free( x12_t );
-exit_level_1:
- LAPACKE_free( x11_t );
-exit_level_0:
- if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
- LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
- }
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -6;
- }
- if( LAPACKE_z_nancheck( MIN(m,k), tau, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -6;
+ }
+ if( LAPACKE_z_nancheck( MIN(m,k), tau, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( n-1, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( n-1, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
- return -5;
- }
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -7;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+ return -5;
+ }
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -7;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n-1, tau, 1 ) ) {
- return -6;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n-1, tau, 1 ) ) {
+ return -6;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- nq = LAPACKE_lsame( side, 'l' ) ? m : n;
- r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
- if( LAPACKE_zge_nancheck( matrix_layout, r, MIN(nq,k), a, lda ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_z_nancheck( MIN(nq,k), tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ nq = LAPACKE_lsame( side, 'l' ) ? m : n;
+ r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
+ if( LAPACKE_zge_nancheck( matrix_layout, r, MIN(nq,k), a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_z_nancheck( MIN(nq,k), tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_zge_nancheck( matrix_layout, r, r, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_z_nancheck( m-1, tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_zge_nancheck( matrix_layout, r, r, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_z_nancheck( m-1, tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
- return -8;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -11;
- }
- if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
- return -10;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) {
+ return -8;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -11;
+ }
+ if( LAPACKE_z_nancheck( k, tau, 1 ) ) {
+ return -10;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_zge_nancheck( matrix_layout, r, r, a, lda ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -10;
- }
- if( LAPACKE_z_nancheck( m-1, tau, 1 ) ) {
- return -9;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_zge_nancheck( matrix_layout, r, r, a, lda ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -10;
+ }
+ if( LAPACKE_z_nancheck( m-1, tau, 1 ) ) {
+ return -9;
+ }
}
#endif
/* Query optimal working array(s) size */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- if( LAPACKE_zpp_nancheck( n, ap ) ) {
- return -4;
- }
- if( LAPACKE_z_nancheck( n-1, tau, 1 ) ) {
- return -5;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ if( LAPACKE_zpp_nancheck( n, ap ) ) {
+ return -4;
+ }
+ if( LAPACKE_z_nancheck( n-1, tau, 1 ) ) {
+ return -5;
+ }
}
#endif
/* Allocate memory for working array(s) */
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
- /* Optionally check input matrices for NaNs */
- r = LAPACKE_lsame( side, 'l' ) ? m : n;
- if( LAPACKE_zpp_nancheck( r, ap ) ) {
- return -7;
- }
- if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
- return -9;
- }
- if( LAPACKE_z_nancheck( m-1, tau, 1 ) ) {
- return -8;
+ if( LAPACKE_get_nancheck() ) {
+ /* Optionally check input matrices for NaNs */
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
+ if( LAPACKE_zpp_nancheck( r, ap ) ) {
+ return -7;
+ }
+ if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+ return -9;
+ }
+ if( LAPACKE_z_nancheck( m-1, tau, 1 ) ) {
+ return -8;
+ }
}
#endif
/* Additional scalars initializations for work arrays */
-set(UTILS_OBJ
+set(UTILS
lapacke_c_nancheck.c lapacke_ctr_trans.c lapacke_make_complex_float.c lapacke_zgb_nancheck.c
lapacke_cgb_nancheck.c lapacke_d_nancheck.c lapacke_s_nancheck.c lapacke_zgb_trans.c
lapacke_cgb_trans.c lapacke_dgb_nancheck.c lapacke_sgb_nancheck.c lapacke_zge_nancheck.c
all: lib
lib: $(OBJ)
- $(ARCH) $(ARCHFLAGS) ../../$(LAPACKELIB) $(OBJ)
+ $(ARCH) $(ARCHFLAGS) ../../$(LAPACKELIB) $^
$(RANLIB) ../../$(LAPACKELIB)
+clean: cleanobj
+cleanobj:
+ rm -f *.o
+
.c.o:
$(CC) $(CFLAGS) -I../include -c -o $@ $<
-
-clean:
- rm -f *.o
* and col_major lower and row_major upper are equals too -
* using one code for equal cases. XOR( colmaj, upper )
*/
- if( ( colmaj || upper ) && !( colmaj && upper ) ) {
+ if( !( colmaj || upper ) || ( colmaj && upper ) ) {
for( j = st; j < n; j++ ) {
for( i = 0; i < j+1-st; i++ ) {
out[ j-i + (i*(2*n-i+1))/2 ] = in[ ((j+1)*j)/2 + i ];
* and col_major lower and row_major upper are equals too -
* using one code for equal cases. XOR( colmaj, upper )
*/
- if( ( colmaj || upper ) && !( colmaj && upper ) ) {
+ if( !( colmaj || upper ) || ( colmaj && upper ) ) {
for( j = st; j < n; j++ ) {
for( i = 0; i < j+1-st; i++ ) {
out[ j-i + (i*(2*n-i+1))/2 ] = in[ ((j+1)*j)/2 + i ];
* and col_major lower and row_major upper are equals too -
* using one code for equal cases. XOR( colmaj, upper )
*/
- if( ( colmaj || upper ) && !( colmaj && upper ) ) {
+ if( !( colmaj || upper ) || ( colmaj && upper ) ) {
for( j = st; j < n; j++ ) {
for( i = 0; i < j+1-st; i++ ) {
out[ j-i + (i*(2*n-i+1))/2 ] = in[ ((j+1)*j)/2 + i ];
* and col_major lower and row_major upper are equals too -
* using one code for equal cases. XOR( colmaj, upper )
*/
- if( ( colmaj || upper ) && !( colmaj && upper ) ) {
+ if( !( colmaj || upper ) || ( colmaj && upper ) ) {
for( j = st; j < n; j++ ) {
for( i = 0; i < j+1-st; i++ ) {
out[ j-i + (i*(2*n-i+1))/2 ] = in[ ((j+1)*j)/2 + i ];
-Copyright (c) 1992-2016 The University of Tennessee and The University
+Copyright (c) 1992-2017 The University of Tennessee and The University
of Tennessee Research Foundation. All rights
reserved.
-Copyright (c) 2000-2016 The University of California Berkeley. All
+Copyright (c) 2000-2017 The University of California Berkeley. All
rights reserved.
-Copyright (c) 2006-2016 The University of Colorado Denver. All rights
+Copyright (c) 2006-2017 The University of Colorado Denver. All rights
reserved.
$COPYRIGHT$
include make.inc
-all: lapack_install lib blas_testing lapack_testing
+all: lapack_install lib blas_testing lapack_testing
lib: lapacklib tmglib
#lib: blaslib variants lapacklib tmglib
-clean: cleanlib cleantesting cleanblas_testing cleancblas_testing
-
-lapack_install:
- ( cd INSTALL; $(MAKE) )
-# ./testlsame; ./testslamch; ./testdlamch; \
-# ./testsecond; ./testdsecnd; ./testieee; ./testversion )
-
blaslib:
- ( cd BLAS/SRC; $(MAKE) )
+ $(MAKE) -C BLAS
cblaslib:
- ( cd CBLAS; $(MAKE) )
+ $(MAKE) -C CBLAS
-lapacklib: lapack_install
- ( cd SRC; $(MAKE) )
+lapacklib:
+ $(MAKE) -C SRC
-lapackelib: lapacklib
- ( cd LAPACKE; $(MAKE) )
-
-cblas_example: cblaslib blaslib
- ( cd CBLAS/examples; $(MAKE) )
+lapackelib:
+ $(MAKE) -C LAPACKE
-lapacke_example: lapackelib
- ( cd LAPACKE/example; $(MAKE) )
+tmglib:
+ $(MAKE) -C TESTING/MATGEN
variants:
- ( cd SRC/VARIANTS ; $(MAKE))
+ $(MAKE) -C SRC/VARIANTS
-tmglib:
- ( cd TESTING/MATGEN; $(MAKE) )
+lapack_install:
+ $(MAKE) -C INSTALL run
+
+blas_testing: blaslib
+ $(MAKE) -C BLAS blas_testing
-lapack_testing: lib
- ( cd TESTING ; $(MAKE) )
+cblas_testing: cblaslib blaslib
+ $(MAKE) -C CBLAS cblas_testing
+
+lapack_testing: tmglib lapacklib blaslib
+ $(MAKE) -C TESTING/LIN cleanexe
+ $(MAKE) -C TESTING
./lapack_testing.py
-variants_testing: lib variants
- ( cd TESTING ; rm -f xlintst* ; $(MAKE) VARLIB='SRC/VARIANTS/LIB/cholrl.a' ; \
- mv stest.out stest_cholrl.out ; mv dtest.out dtest_cholrl.out ; mv ctest.out ctest_cholrl.out ; mv ztest.out ztest_cholrl.out )
- ( cd TESTING ; rm -f xlintst* ; $(MAKE) VARLIB='SRC/VARIANTS/LIB/choltop.a' ; \
- mv stest.out stest_choltop.out ; mv dtest.out dtest_choltop.out ; mv ctest.out ctest_choltop.out ; mv ztest.out ztest_choltop.out )
- ( cd TESTING ; rm -f xlintst* ; $(MAKE) VARLIB='SRC/VARIANTS/LIB/lucr.a' ; \
- mv stest.out stest_lucr.out ; mv dtest.out dtest_lucr.out ; mv ctest.out ctest_lucr.out ; mv ztest.out ztest_lucr.out )
- ( cd TESTING ; rm -f xlintst* ; $(MAKE) VARLIB='SRC/VARIANTS/LIB/lull.a' ; \
- mv stest.out stest_lull.out ; mv dtest.out dtest_lull.out ; mv ctest.out ctest_lull.out ; mv ztest.out ztest_lull.out )
- ( cd TESTING ; rm -f xlintst* ; $(MAKE) VARLIB='SRC/VARIANTS/LIB/lurec.a' ; \
- mv stest.out stest_lurec.out ; mv dtest.out dtest_lurec.out ; mv ctest.out ctest_lurec.out ; mv ztest.out ztest_lurec.out )
- ( cd TESTING ; rm -f xlintst* ; $(MAKE) VARLIB='SRC/VARIANTS/LIB/qrll.a' ; \
- mv stest.out stest_qrll.out ; mv dtest.out dtest_qrll.out ; mv ctest.out ctest_qrll.out ; mv ztest.out ztest_qrll.out )
-
-blas_testing:
- ( cd BLAS/TESTING; $(MAKE) -f Makeblat1 )
- ( cd BLAS; ./xblat1s > sblat1.out ; \
- ./xblat1d > dblat1.out ; \
- ./xblat1c > cblat1.out ; \
- ./xblat1z > zblat1.out )
- ( cd BLAS/TESTING; $(MAKE) -f Makeblat2 )
- ( cd BLAS; ./xblat2s < sblat2.in ; \
- ./xblat2d < dblat2.in ; \
- ./xblat2c < cblat2.in ; \
- ./xblat2z < zblat2.in )
- ( cd BLAS/TESTING; $(MAKE) -f Makeblat3 )
- ( cd BLAS; ./xblat3s < sblat3.in ; \
- ./xblat3d < dblat3.in ; \
- ./xblat3c < cblat3.in ; \
- ./xblat3z < zblat3.in )
-
-cblas_testing: blaslib
- ( cd CBLAS ; $(MAKE) cblas_testing)
- ( cd CBLAS ; $(MAKE) runtst)
+variants_testing: tmglib variants lapacklib blaslib
+ $(MAKE) -C TESTING/LIN cleanexe
+ $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/cholrl.a'
+ $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_cholrl.out
+ $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_cholrl.out
+ $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_cholrl.out
+ $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_cholrl.out
+ $(MAKE) -C TESTING/LIN cleanexe
+ $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/choltop.a'
+ $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_choltop.out
+ $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_choltop.out
+ $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_choltop.out
+ $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_choltop.out
+ $(MAKE) -C TESTING/LIN cleanexe
+ $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/lucr.a'
+ $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_lucr.out
+ $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_lucr.out
+ $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_lucr.out
+ $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_lucr.out
+ $(MAKE) -C TESTING/LIN cleanexe
+ $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/lull.a'
+ $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_lull.out
+ $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_lull.out
+ $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_lull.out
+ $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_lull.out
+ $(MAKE) -C TESTING/LIN cleanexe
+ $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/lurec.a'
+ $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_lurec.out
+ $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_lurec.out
+ $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_lurec.out
+ $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_lurec.out
+ $(MAKE) -C TESTING/LIN cleanexe
+ $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/qrll.a'
+ $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_qrll.out
+ $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_qrll.out
+ $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_qrll.out
+ $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_qrll.out
+cblas_example: cblaslib blaslib
+ $(MAKE) -C CBLAS cblas_example
+lapacke_example: lapackelib lapacklib blaslib
+ $(MAKE) -C LAPACKE lapacke_example
html:
- @echo "LAPACK HTML PAGES GENRATION with Doxygen"
+ @echo "LAPACK HTML PAGES GENERATION with Doxygen"
doxygen DOCS/Doxyfile
- @echo "=================="
- @echo "LAPACK HTML PAGES GENRATED in DOCS/explore-html"
+ @echo "=================="
+ @echo "LAPACK HTML PAGES GENERATED in DOCS/explore-html"
@echo "Usage: open DOCS/explore-html/index.html"
@echo "Online version available at http://www.netlib.org/lapack/explore-html/"
@echo "=================="
man:
- @echo "LAPACK MAN PAGES GENRATION with Doxygen"
+ @echo "LAPACK MAN PAGES GENERATION with Doxygen"
doxygen DOCS/Doxyfile_man
@echo "=================="
- @echo "LAPACK MAN PAGES GENRATED in DOCS/MAN"
+ @echo "LAPACK MAN PAGES GENERATED in DOCS/MAN"
@echo "Set your MANPATH env variable accordingly"
@echo "Usage: man dgetrf.f"
@echo "=================="
+clean:
+ $(MAKE) -C INSTALL clean
+ $(MAKE) -C BLAS clean
+ $(MAKE) -C CBLAS clean
+ $(MAKE) -C SRC clean
+ $(MAKE) -C SRC/VARIANTS clean
+ $(MAKE) -C TESTING clean
+ $(MAKE) -C TESTING/MATGEN clean
+ $(MAKE) -C TESTING/LIN clean
+ $(MAKE) -C TESTING/EIG clean
+ $(MAKE) -C LAPACKE clean
+ rm -f *.a
+cleanobj:
+ $(MAKE) -C INSTALL cleanobj
+ $(MAKE) -C BLAS cleanobj
+ $(MAKE) -C CBLAS cleanobj
+ $(MAKE) -C SRC cleanobj
+ $(MAKE) -C SRC/VARIANTS cleanobj
+ $(MAKE) -C TESTING/MATGEN cleanobj
+ $(MAKE) -C TESTING/LIN cleanobj
+ $(MAKE) -C TESTING/EIG cleanobj
+ $(MAKE) -C LAPACKE cleanobj
cleanlib:
- ( cd INSTALL; $(MAKE) clean )
- ( cd BLAS/SRC; $(MAKE) clean )
- ( cd CBLAS; $(MAKE) clean )
- ( cd SRC; $(MAKE) clean )
- ( cd SRC/VARIANTS; $(MAKE) clean )
- ( cd TESTING/MATGEN; $(MAKE) clean )
- ( cd LAPACKE; $(MAKE) clean )
-
-
-cleanblas_testing:
- ( cd BLAS/TESTING; $(MAKE) -f Makeblat1 clean )
- ( cd BLAS/TESTING; $(MAKE) -f Makeblat2 clean )
- ( cd BLAS/TESTING; $(MAKE) -f Makeblat3 clean )
- ( cd BLAS; rm -f xblat* )
-
-cleancblas_testing:
- ( cd CBLAS/testing; $(MAKE) clean )
-
-cleantesting:
- ( cd TESTING/LIN; $(MAKE) clean )
- ( cd TESTING/EIG; $(MAKE) clean )
- ( cd TESTING; rm -f xlin* xeig* )
-
-cleanall: cleanlib cleanblas_testing cleancblas_testing cleantesting
- rm -f *.a TESTING/*.out INSTALL/test* BLAS/*.out
-
+ $(MAKE) -C BLAS cleanlib
+ $(MAKE) -C CBLAS cleanlib
+ $(MAKE) -C SRC cleanlib
+ $(MAKE) -C SRC/VARIANTS cleanlib
+ $(MAKE) -C TESTING/MATGEN cleanlib
+ $(MAKE) -C LAPACKE cleanlib
+ rm -f *.a
+cleanexe:
+ $(MAKE) -C INSTALL cleanexe
+ $(MAKE) -C BLAS cleanexe
+ $(MAKE) -C CBLAS cleanexe
+ $(MAKE) -C TESTING/LIN cleanexe
+ $(MAKE) -C TESTING/EIG cleanexe
+ $(MAKE) -C LAPACKE cleanexe
+cleantest:
+ $(MAKE) -C INSTALL cleantest
+ $(MAKE) -C BLAS cleantest
+ $(MAKE) -C CBLAS cleantest
+ $(MAKE) -C TESTING cleantest
# LAPACK
[](https://travis-ci.org/Reference-LAPACK/lapack)
+[](https://ci.appveyor.com/project/langou/lapack/)
+[](https://codecov.io/gh/Reference-LAPACK/lapack)
+
* VERSION 1.0 : February 29, 1992
* VERSION 1.0a : June 30, 1992
* VERSION 3.6.0 : November 2015
* VERSION 3.6.1 : June 2016
* VERSION 3.7.0 : December 2016
+* VERSION 3.7.1 : June 2017
+* VERSION 3.8.0 : November 2017
+
+LAPACK is a library of Fortran subroutines for solving the most commonly
+occurring problems in numerical linear algebra.
+
+LAPACK is a freely-available software package. It can be included in commercial
+software packages (and has been). We only ask that that proper credit be given
+to the authors, for example by citing the LAPACK Users' Guide. The license used
+for the software is the modified BSD license, see:
+https://github.com/Reference-LAPACK/lapack/blob/master/LICENSE
-LAPACK is a library of Fortran 90 with subroutines for solving
-the most commonly occurring problems in numerical linear algebra.
-It is freely-available software, and is copyrighted.
+Like all software, it is copyrighted. It is not trademarked, but we do ask the
+following: if you modify the source for these routines we ask that you change
+the name of the routine and comment the changes made to the original.
-LAPACK is available on netlib and can be obtained via the World Wide
-Web and anonymous ftp.
+We will gladly answer any questions regarding the software. If a modification
+is done, however, it is the responsibility of the person who modified the
+routine to provide support.
- http://www.netlib.org/lapack/
+LAPACK is available from github at:
+https://github.com/reference-lapack/lapack
-The distribution tar file contains the Fortran source for LAPACK and the
-testing programs. It also contains the Fortran77
-reference implementation of the Basic Linear Algebra Subprograms
-(the Level 1, 2, and 3 BLAS) needed by LAPACK. However this code is
-intended for use only if there is no other implementation of the BLAS
-already available on your machine; the efficiency of LAPACK depends
-very much on the efficiency of the BLAS.
+LAPACK releases are also available on netlib at:
+http://www.netlib.org/lapack/
+
+The distribution contains (1) the Fortran source for LAPACK, and (2) its
+testing programs. It also contains (3) the Fortran reference implementation of
+the Basic Linear Algebra Subprograms (the Level 1, 2, and 3 BLAS) needed by
+LAPACK. However this code is intended for use only if there is no other
+implementation of the BLAS already available on your machine; the efficiency of
+LAPACK depends very much on the efficiency of the BLAS. It also contains (4)
+CBLAS, a C interface to the BLAS, and (5) LAPACKE, a C interface to LAPACK.
## Installation
- - LAPACK can be installed with `make`. Configuration have to be set in the
+ - LAPACK can be installed with `make`. The configuration have to be set in the
`make.inc` file. A `make.inc.example` for a Linux machine running GNU compilers
is given in the main directory. Some specific `make.inc` are also available in
the `INSTALL` directory.
- LAPACK includes also the CMake build. You will need to have CMake installed
on your machine (CMake is available at http://www.cmake.org/). CMake will
allow an easy installation on a Windows Machine.
- - Specific information to run LAPACK under Windows are available at
+ - Specific information to run LAPACK under Windows is available at
http://icl.cs.utk.edu/lapack-for-windows/lapack/.
- For further information on LAPACK please read our FAQ at
- http://www.netlib.org/lapack/#_faq
- A User forum is also available to help you with the LAPACK library at
- http://icl.cs.utk.edu/lapack-forum/
-
## User Support
-LAPACK has been thoroughly tested, on many different
-types of computers. The LAPACK project supports the package in the
-sense that reports of errors or poor performance will gain immediate
-attention from the developers. Such reports, descriptions
-of interesting applications, and other comments should be sent by
-electronic mail to lapack@cs.utk.edu.
+LAPACK has been thoroughly tested, on many different types of computers. The
+LAPACK project supports the package in the sense that reports of errors or poor
+performance will gain immediate attention from the developers. Such reports,
+descriptions of interesting applications, and other comments should be sent by
+electronic mail to lapack@icl.utk.edu.
+
+For further information on LAPACK please read our FAQ at
+http://www.netlib.org/lapack/#_faq.
A list of known problems, bugs, and compiler errors for LAPACK is
-maintained on netlib.
- * http://www.netlib.org/lapack/release_notes.html
+maintained on netlib
+http://www.netlib.org/lapack/release_notes.html.
+Please see as well
+https://github.com/Reference-LAPACK/lapack/issues.
A User forum is also available to help you with the LAPACK library at
- http://icl.cs.utk.edu/lapack-forum/.
-You can also contact directly the LAPACK team at lapack@cs.utk.edu.
+http://icl.cs.utk.edu/lapack-forum/.
+You can also contact directly the LAPACK team at lapack@icl.utk.edu.
## Testing
-The complete package, including test code in four
-different Fortran data types (real, complex, double precision, double
-complex), contains some 805,000 lines of Fortran source and comments.
-You will need approximately 33 Mbytes to read the complete tape.
-We recommend that you run the testing. The total
-space requirements for the testing for all four data
-types, including the object files, is approximately 80 Mbytes.
-
-A README file containing the information in this letter is located
-in the LAPACK directory. Postscript and LaTeX versions of the Quick
-Installation Guide are in the `LAPACK/INSTALL` directory, in the files
-`lawn81.tex`, `psfig.tex`, `lawn81.ps`, and `org2.ps`. Consult the Installation
-Guide for further details on installing the package and on what is contained
-in each subdirectory. For complete information on the LAPACK Testing
-please consult LAPACK Working Note 41 "Installation
-Guide for LAPACK".
+LAPACK includes a thorough test suite. We recommend that, after compilation,
+you run the test suite.
+For complete information on the LAPACK Testing please consult LAPACK Working
+Note 41 "Installation Guide for LAPACK".
## User Guide
-It is highly recommended that you obtain a copy of the Third Edition of
-the LAPACK Users' Guide published by SIAM in Winter, 1999. This Users'
-Guide gives a detailed description of the philosophy behind LAPACK as well
-as an explanation of its usage. The LAPACK Users' Guide can be purchased from:
-SIAM; Customer Service; P. O. Box 7260; Philadelphia, PA 19104;
-215-382-9800, FAX 215-386-7999. It will also be available from booksellers.
-
-To order by email, send email to service@siam.org. The book is also
-available via SIAM's World Wide Web URL at http://www.siam.org. The
-ISBN number is 0-89871-447-8, and SIAM order code is SE09. The list
-price for SIAM members is $31.20; the cost for nonmembers is $39.00.
-
To view an HTML version of the Users' Guide please refer to the URL
-
http://www.netlib.org/lapack/lug/lapack_lug.html.
## LAPACKE
-LAPACK now includes the LAPACKE package
-LAPACKE is a Standard C language APIs for LAPACK
-http://www.netlib.org/lapack/#_standard_c_language_apis_for_lapack
-collaboration LAPACK and INTEL Math Kernel Library
-
-Documentation available in the DOCS folder
-
-## Related Projects
-
-The Fortran95 interface to LAPACK is available, as well as an f2c'ed
-version of LAPACK, and a C++ version of a subset of LAPACK routines.
-Refer to the following URLs on netlib for further information:
-
- * http://www.netlib.org/lapack95/
- * http://www.netlib.org/clapack/
- * http://www.netlib.org/lapack++/
- * http://www.cs.utk.edu/java/f2j/
-
-Or, for more information on the distributed-memory version of LAPACK,
-consult the ScaLAPACK index on netlib:
-
- http://www.netlib.org/scalapack/
-
-
-## Working Notes
-A number of technical reports were written during the development of
-LAPACK and published as LAPACK Working Notes, initially by Argonne
-National Laboratory and later by the University of Tennessee. Many of
-these reports later appeared as journal articles. Most of these working
-notes are available in pdf and postscript form from netlib.
- * http://www.netlib.org/lapack/lawns/
- * http://www.netlib.org/lapack/lawnspdf/
-Otherwise, requests for copies of these working notes can be sent to
-the following address.
+LAPACK now includes the LAPACKE package. LAPACKE is a Standard C language API
+for LAPACK This was born from a collaboration of the LAPACK and INTEL Math
+Kernel Library teams. See:
+http://www.netlib.org/lapack/#_standard_c_language_apis_for_lapack.
-LAPACK Project, c/o J.J. Dongarra, Computer Science Department, University of Tennessee, Knoxville, Tennessee 37996-1301, USA, Email: lapack@cs.utk.edu.
#######################################################################
# This is the makefile to create a library for LAPACK.
# The files are organized as follows:
+
# ALLAUX -- Auxiliary routines called from all precisions
-#
-# SCLAUX -- Auxiliary routines called from both REAL and COMPLEX.
-# DZLAUX -- Auxiliary routines called from both DOUBLE and COMPLEX*16.
+# SCLAUX -- Auxiliary routines called from single precision
+# DZLAUX -- Auxiliary routines called from double precision
#
# DSLASRC -- Double-single mixed precision real routines called from
# single, single-extra and double precision real LAPACK
#
# DEPRECATED -- Deprecated routines in all precisions
#
-# The library can be set up to include routines for any combination
-# of the four precisions. To create or add to the library, enter make
-# followed by one or more of the precisions desired. Some examples:
-# make single
-# make single complex
-# make single double complex complex16
-# Alternatively, the command
-# make
-# without any arguments creates a library of all four precisions.
-# The library is called
-# lapack.a
-# and is created at the next higher directory level.
-#
-# To remove the object files after the library is created, enter
-# make clean
-# On some systems, you can force the source files to be recompiled by
-# entering (for example)
-# make single FRC=FRC
-#
# ***Note***
# The functions lsame, second, dsecnd, slamch, and dlamch may have
# to be installed before compiling the library. Refer to the
#
#######################################################################
-set(ALLAUX ilaenv.f ieeeck.f lsamen.f iparmq.f iparam2stage.F
+set(ALLAUX ilaenv.f ilaenv2stage.f ieeeck.f lsamen.f iparmq.f iparam2stage.F
ilaprec.f ilatrans.f ilauplo.f iladiag.f chla_transtype.f
../INSTALL/ilaver.f ../INSTALL/lsame.f xerbla.f xerbla_array.f
../INSTALL/slamch.f)
sgels.f sgelsd.f sgelss.f sgelsy.f sgeql2.f sgeqlf.f
sgeqp3.f sgeqr2.f sgeqr2p.f sgeqrf.f sgeqrfp.f sgerfs.f sgerq2.f sgerqf.f
sgesc2.f sgesdd.f sgesv.f sgesvd.f sgesvdx.f sgesvx.f sgetc2.f sgetf2.f
- sgetrf.f sgetrf2.f sgetri.f
- sgetrs.f sggbak.f sggbal.f
+ sgetrf2.f sgetri.f
+ sggbak.f sggbal.f
sgges.f sgges3.f sggesx.f sggev.f sggev3.f sggevx.f
sggglm.f sgghrd.f sgghd3.f sgglse.f sggqrf.f
sggrqf.f sggsvd3.f sggsvp3.f sgtcon.f sgtrfs.f sgtsv.f
sormr3.f sormrq.f sormrz.f sormtr.f spbcon.f spbequ.f spbrfs.f
spbstf.f spbsv.f spbsvx.f
spbtf2.f spbtrf.f spbtrs.f spocon.f spoequ.f sporfs.f sposv.f
- sposvx.f spotf2.f spotrf.f spotrf2.f spotri.f spotrs.f spstrf.f spstf2.f
+ sposvx.f spotf2.f spotrf2.f spotri.f spstrf.f spstf2.f
sppcon.f sppequ.f
spprfs.f sppsv.f sppsvx.f spptrf.f spptri.f spptrs.f sptcon.f
spteqr.f sptrfs.f sptsv.f sptsvx.f spttrs.f sptts2.f srscl.f
ssytd2.f ssytf2.f ssytrd.f ssytrf.f ssytri.f ssytri2.f ssytri2x.f
ssyswapr.f ssytrs.f ssytrs2.f
ssyconv.f ssyconvf.f ssyconvf_rook.f
- ssysv_aa.f ssytrf_aa.f ssytrs_aa.f
ssytf2_rook.f ssytrf_rook.f ssytrs_rook.f
ssytri_rook.f ssycon_rook.f ssysv_rook.f
ssytf2_rk.f ssytrf_rk.f ssytrs_3.f
ssytri_3.f ssytri_3x.f ssycon_3.f ssysv_rk.f
ssysv_aa.f ssytrf_aa.f ssytrs_aa.f
+ ssysv_aa_2stage.f ssytrf_aa_2stage.f ssytrs_aa_2stage.f
stbcon.f
stbrfs.f stbtrs.f stgevc.f stgex2.f stgexc.f stgsen.f
stgsja.f stgsna.f stgsy2.f stgsyl.f stpcon.f stprfs.f stptri.f
cgeqr2.f cgeqr2p.f cgeqrf.f cgeqrfp.f cgerfs.f cgerq2.f cgerqf.f
cgesc2.f cgesdd.f cgesv.f cgesvd.f cgesvdx.f
cgesvj.f cgejsv.f cgsvj0.f cgsvj1.f
- cgesvx.f cgetc2.f cgetf2.f cgetrf.f cgetrf2.f
- cgetri.f cgetrs.f
+ cgesvx.f cgetc2.f cgetf2.f cgetrf2.f
+ cgetri.f
cggbak.f cggbal.f
cgges.f cgges3.f cggesx.f cggev.f cggev3.f cggevx.f
cggglm.f cgghrd.f cgghd3.f cgglse.f cggqrf.f cggrqf.f
chetf2_rk.f chetrf_rk.f chetri_3.f chetri_3x.f
chetrs_3.f checon_3.f chesv_rk.f
chesv_aa.f chetrf_aa.f chetrs_aa.f
+ chesv_aa_2stage.f chetrf_aa_2stage.f chetrs_aa_2stage.f
chgeqz.f chpcon.f chpev.f chpevd.f
chpevx.f chpgst.f chpgv.f chpgvd.f chpgvx.f chprfs.f chpsv.f
chpsvx.f
clatbs.f clatdf.f clatps.f clatrd.f clatrs.f clatrz.f
clauu2.f clauum.f cpbcon.f cpbequ.f cpbrfs.f cpbstf.f cpbsv.f
cpbsvx.f cpbtf2.f cpbtrf.f cpbtrs.f cpocon.f cpoequ.f cporfs.f
- cposv.f cposvx.f cpotf2.f cpotrf.f cpotrf2.f cpotri.f cpotrs.f cpstrf.f cpstf2.f
+ cposv.f cposvx.f cpotf2.f cpotrf2.f cpotri.f cpstrf.f cpstf2.f
cppcon.f cppequ.f cpprfs.f cppsv.f cppsvx.f cpptrf.f cpptri.f cpptrs.f
cptcon.f cpteqr.f cptrfs.f cptsv.f cptsvx.f cpttrf.f cpttrs.f cptts2.f
crot.f cspcon.f cspmv.f cspr.f csprfs.f cspsv.f
csytri_rook.f csycon_rook.f csysv_rook.f
csytf2_rk.f csytrf_rk.f csytrf_aa.f csytrs_3.f csytrs_aa.f
csytri_3.f csytri_3x.f csycon_3.f csysv_rk.f csysv_aa.f
+ csysv_aa_2stage.f csytrf_aa_2stage.f csytrs_aa_2stage.f
ctbcon.f ctbrfs.f ctbtrs.f ctgevc.f ctgex2.f
ctgexc.f ctgsen.f ctgsja.f ctgsna.f ctgsy2.f ctgsyl.f ctpcon.f
ctprfs.f ctptri.f
dsytf2_rk.f dsytrf_rk.f dsytrs_3.f
dsytri_3.f dsytri_3x.f dsycon_3.f dsysv_rk.f
dsysv_aa.f dsytrf_aa.f dsytrs_aa.f
+ dsysv_aa_2stage.f dsytrf_aa_2stage.f dsytrs_aa_2stage.f
dtbcon.f
dtbrfs.f dtbtrs.f dtgevc.f dtgex2.f dtgexc.f dtgsen.f
dtgsja.f dtgsna.f dtgsy2.f dtgsyl.f dtpcon.f dtprfs.f dtptri.f
zhetf2_rk.f zhetrf_rk.f zhetri_3.f zhetri_3x.f
zhetrs_3.f zhecon_3.f zhesv_rk.f
zhesv_aa.f zhetrf_aa.f zhetrs_aa.f
+ zhesv_aa_2stage.f zhetrf_aa_2stage.f zhetrs_aa_2stage.f
zhgeqz.f zhpcon.f zhpev.f zhpevd.f
zhpevx.f zhpgst.f zhpgv.f zhpgvd.f zhpgvx.f zhprfs.f zhpsv.f
zhpsvx.f
zsytf2_rook.f zsytrf_rook.f zsytrs_rook.f zsytrs_aa.f
zsytri_rook.f zsycon_rook.f zsysv_rook.f
zsytf2_rk.f zsytrf_rk.f zsytrf_aa.f zsytrs_3.f
+ zsysv_aa_2stage.f zsytrf_aa_2stage.f zsytrs_aa_2stage.f
zsytri_3.f zsytri_3x.f zsycon_3.f zsysv_rk.f zsysv_aa.f
ztbcon.f ztbrfs.f ztbtrs.f ztgevc.f ztgex2.f
ztgexc.f ztgsen.f ztgsja.f ztgsna.f ztgsy2.f ztgsyl.f ztpcon.f
zla_heamv.f zla_hercond_c.f zla_hercond_x.f zla_herpvgrw.f
zla_lin_berr.f zlarscl2.f zlascl2.f zla_wwaddw.f)
-
-if(USE_XBLAS)
- set(ALLXOBJ ${SXLASRC} ${DXLASRC} ${CXLASRC} ${ZXLASRC})
-endif()
-
if(BUILD_DEPRECATED)
list(APPEND SLASRC DEPRECATED/sgegs.f DEPRECATED/sgegv.f
DEPRECATED/sgeqpf.f DEPRECATED/sgelsx.f DEPRECATED/sggsvd.f
list(APPEND ZLASRC DEPRECATED/zgegs.f DEPRECATED/zgegv.f
DEPRECATED/zgeqpf.f DEPRECATED/zgelsx.f DEPRECATED/zggsvd.f
DEPRECATED/zggsvp.f DEPRECATED/zlahrd.f DEPRECATED/zlatzm.f DEPRECATED/ztzrqf.f)
- message(STATUS "Building deprecated routines")
endif()
+if(USE_XBLAS)
+ list(APPEND SLASRC ${SXLASRC})
+ list(APPEND DLASRC ${DXLASRC})
+ list(APPEND CLASRC ${CXLASRC})
+ list(APPEND ZLASRC ${ZXLASRC})
+endif()
+
+
+set(SOURCES)
if(BUILD_SINGLE)
- set(ALLOBJ ${SLASRC} ${ALLAUX} ${SCLAUX})
- message(STATUS "Building Single Precision")
+ list(APPEND SOURCES ${SLASRC} ${DSLASRC} ${SCLAUX} ${ALLAUX})
endif()
if(BUILD_DOUBLE)
- set(ALLOBJ ${ALLOBJ} ${DLASRC} ${ALLAUX} ${DZLAUX} ${DSLASRC})
- message(STATUS "Building Double Precision")
+ list(APPEND SOURCES ${DLASRC} ${DSLASRC} ${DZLAUX} ${ALLAUX})
endif()
if(BUILD_COMPLEX)
- set(ALLOBJ ${ALLOBJ} ${CLASRC} ${ALLAUX} ${SCLAUX})
- message(STATUS "Building Complex Precision")
+ list(APPEND SOURCES ${CLASRC} ${ZCLASRC} ${SCLAUX} ${ALLAUX})
endif()
if(BUILD_COMPLEX16)
- set(ALLOBJ ${ALLOBJ} ${ZLASRC} ${ALLAUX} ${DZLAUX} ${ZCLASRC})
- message(STATUS "Building Double Complex Precision")
-endif()
-
-if(NOT ALLOBJ)
- message(FATAL_ERROR "-->LAPACK SRC BUILD: NOTHING TO BUILD, NO PRECISION SELECTED:
- PLEASE ENABLE AT LEAST ONE OF THOSE: BUILD_SINGLE, BUILD_COMPLEX, BUILD_DOUBLE, BUILD_COMPLEX16.")
+ list(APPEND SOURCES ${ZLASRC} ${ZCLASRC} ${DZLAUX} ${ALLAUX})
endif()
+list(REMOVE_DUPLICATES SOURCES)
-list(REMOVE_DUPLICATES ALLOBJ)
-
-add_library(lapack ${ALLOBJ} ${ALLXOBJ})
-target_link_libraries(lapack ${BLAS_LIBRARIES} ${XBLAS_LIBRARY})
-
+add_library(lapack ${SOURCES})
set_target_properties(
lapack PROPERTIES
VERSION ${LAPACK_VERSION}
SOVERSION ${LAPACK_MAJOR_VERSION}
)
+if(USE_XBLAS)
+ target_link_libraries(lapack PRIVATE ${XBLAS_LIBRARY})
+endif()
+target_link_libraries(lapack PRIVATE ${BLAS_LIBRARIES})
+
+if (${CMAKE_BUILD_TYPE_UPPER} STREQUAL "COVERAGE")
+ target_link_libraries(lapack PRIVATE gcov)
+ add_coverage(lapack)
+endif()
+
lapack_install_library(lapack)
#######################################################################
# This is the makefile to create a library for LAPACK.
# The files are organized as follows:
-# ALLAUX -- Auxiliary routines called from all precisions
#
-# SCLAUX -- Auxiliary routines called from both REAL and COMPLEX.
-# DZLAUX -- Auxiliary routines called from both DOUBLE and COMPLEX*16.
+# ALLAUX -- Auxiliary routines called from all precisions
+# SCLAUX -- Auxiliary routines called from single precision
+# DZLAUX -- Auxiliary routines called from double precision
#
# DSLASRC -- Double-single mixed precision real routines called from
# single, single-extra and double precision real LAPACK
#
#######################################################################
-ALLAUX_O = ilaenv.o ieeeck.o lsamen.o xerbla.o xerbla_array.o iparmq.o iparam2stage.o\
+ALLAUX_O = ilaenv.o ilaenv2stage.o ieeeck.o lsamen.o xerbla.o xerbla_array.o \
+ iparmq.o iparam2stage.o \
ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o \
../INSTALL/ilaver.o ../INSTALL/lsame.o ../INSTALL/slamch.o
ssycon.o ssyev.o ssyevd.o ssyevr.o ssyevx.o ssygs2.o \
ssygst.o ssygv.o ssygvd.o ssygvx.o ssyrfs.o ssysv.o ssysvx.o \
ssytd2.o ssytf2.o ssytrd.o ssytrf.o ssytri.o ssytri2.o ssytri2x.o \
- ssyswapr.o ssytrs.o ssytrs2.o ssyconv.o ssyconvf_rook.o \
+ ssyswapr.o ssytrs.o ssytrs2.o \
+ ssyconv.o ssyconvf.o ssyconvf_rook.o \
ssytf2_rook.o ssytrf_rook.o ssytrs_rook.o \
ssytri_rook.o ssycon_rook.o ssysv_rook.o \
ssytf2_rk.o ssytrf_rk.o ssytrs_3.o \
ssytri_3.o ssytri_3x.o ssycon_3.o ssysv_rk.o \
slasyf_aa.o ssysv_aa.o ssytrf_aa.o ssytrs_aa.o \
+ ssysv_aa_2stage.o ssytrf_aa_2stage.o ssytrs_aa_2stage.o \
stbcon.o \
stbrfs.o stbtrs.o stgevc.o stgex2.o stgexc.o stgsen.o \
stgsja.o stgsna.o stgsy2.o stgsyl.o stpcon.o stprfs.o stptri.o \
chetrs_rook.o checon_rook.o chesv_rook.o \
chetf2_rk.o chetrf_rk.o chetri_3.o chetri_3x.o \
chetrs_3.o checon_3.o chesv_rk.o \
- chesv_aa.o chetrf_aa.o chetrs_aa.o clahef_aa.o\
+ chesv_aa.o chetrf_aa.o chetrs_aa.o clahef_aa.o \
+ chesv_aa_2stage.o chetrf_aa_2stage.o chetrs_aa_2stage.o \
chgeqz.o chpcon.o chpev.o chpevd.o \
chpevx.o chpgst.o chpgv.o chpgvd.o chpgvx.o chprfs.o chpsv.o \
chpsvx.o \
csytri_rook.o csycon_rook.o csysv_rook.o \
csytf2_rk.o csytrf_rk.o csytrf_aa.o csytrs_3.o csytrs_aa.o \
csytri_3.o csytri_3x.o csycon_3.o csysv_rk.o csysv_aa.o \
+ csysv_aa_2stage.o csytrf_aa_2stage.o csytrs_aa_2stage.o \
ctbcon.o ctbrfs.o ctbtrs.o ctgevc.o ctgex2.o \
ctgexc.o ctgsen.o ctgsja.o ctgsna.o ctgsy2.o ctgsyl.o ctpcon.o \
ctprfs.o ctptri.o \
dsytf2_rk.o dsytrf_rk.o dsytrs_3.o \
dsytri_3.o dsytri_3x.o dsycon_3.o dsysv_rk.o \
dlasyf_aa.o dsysv_aa.o dsytrf_aa.o dsytrs_aa.o \
+ dsysv_aa_2stage.o dsytrf_aa_2stage.o dsytrs_aa_2stage.o \
dtbcon.o dtbrfs.o dtbtrs.o dtgevc.o dtgex2.o dtgexc.o dtgsen.o \
dtgsja.o dtgsna.o dtgsy2.o dtgsyl.o dtpcon.o dtprfs.o dtptri.o \
dtptrs.o \
zhetf2_rk.o zhetrf_rk.o zhetri_3.o zhetri_3x.o \
zhetrs_3.o zhecon_3.o zhesv_rk.o \
zhesv_aa.o zhetrf_aa.o zhetrs_aa.o zlahef_aa.o \
+ zhesv_aa_2stage.o zhetrf_aa_2stage.o zhetrs_aa_2stage.o \
zhgeqz.o zhpcon.o zhpev.o zhpevd.o \
zhpevx.o zhpgst.o zhpgv.o zhpgvd.o zhpgvx.o zhprfs.o zhpsv.o \
zhpsvx.o \
zsyconv.o zsyconvf.o zsyconvf_rook.o \
zsytf2_rook.o zsytrf_rook.o zsytrs_rook.o zsytrs_aa.o \
zsytri_rook.o zsycon_rook.o zsysv_rook.o \
+ zsysv_aa_2stage.o zsytrf_aa_2stage.o zsytrs_aa_2stage.o \
zsytf2_rk.o zsytrf_rk.o zsytrf_aa.o zsytrs_3.o \
zsytri_3.o zsytri_3x.o zsycon_3.o zsysv_rk.o zsysv_aa.o \
ztbcon.o ztbrfs.o ztbtrs.o ztgevc.o ztgex2.o \
# 1065-1081. http://dx.doi.org/10.1137/S0895479896297744
#######################################################################
-VARIANTSDIR = LIB
-
CHOLRL = cholesky/RL/cpotrf.o cholesky/RL/dpotrf.o cholesky/RL/spotrf.o cholesky/RL/zpotrf.o
CHOLTOP = cholesky/TOP/cpotrf.o cholesky/TOP/dpotrf.o cholesky/TOP/spotrf.o cholesky/TOP/zpotrf.o
QRLL = qr/LL/cgeqrf.o qr/LL/dgeqrf.o qr/LL/sgeqrf.o qr/LL/zgeqrf.o qr/LL/sceil.o
-all: cholrl choltop lucr lull lurec qrll
+all: cholrl.a choltop.a lucr.a lull.a lurec.a qrll.a
-cholrl: $(CHOLRL)
- $(ARCH) $(ARCHFLAGS) $(VARIANTSDIR)/cholrl.a $(CHOLRL)
- $(RANLIB) $(VARIANTSDIR)/cholrl.a
+cholrl.a: $(CHOLRL)
+ $(ARCH) $(ARCHFLAGS) $@ $^
+ $(RANLIB) $@
-choltop: $(CHOLTOP)
- $(ARCH) $(ARCHFLAGS) $(VARIANTSDIR)/choltop.a $(CHOLTOP)
- $(RANLIB) $(VARIANTSDIR)/choltop.a
+choltop.a: $(CHOLTOP)
+ $(ARCH) $(ARCHFLAGS) $@ $^
+ $(RANLIB) $@
-lucr: $(LUCR)
- $(ARCH) $(ARCHFLAGS) $(VARIANTSDIR)/lucr.a $(LUCR)
- $(RANLIB) $(VARIANTSDIR)/lucr.a
+lucr.a: $(LUCR)
+ $(ARCH) $(ARCHFLAGS) $@ $^
+ $(RANLIB) $@
-lull: $(LULL)
- $(ARCH) $(ARCHFLAGS) $(VARIANTSDIR)/lull.a $(LULL)
- $(RANLIB) $(VARIANTSDIR)/lull.a
+lull.a: $(LULL)
+ $(ARCH) $(ARCHFLAGS) $@ $^
+ $(RANLIB) $@
-lurec: $(LUREC)
- $(ARCH) $(ARCHFLAGS) $(VARIANTSDIR)/lurec.a $(LUREC)
- $(RANLIB) $(VARIANTSDIR)/lurec.a
+lurec.a: $(LUREC)
+ $(ARCH) $(ARCHFLAGS) $@ $^
+ $(RANLIB) $@
-qrll: $(QRLL)
- $(ARCH) $(ARCHFLAGS) $(VARIANTSDIR)/qrll.a $(QRLL)
- $(RANLIB) $(VARIANTSDIR)/qrll.a
+qrll.a: $(QRLL)
+ $(ARCH) $(ARCHFLAGS) $@ $^
+ $(RANLIB) $@
+clean: cleanobj cleanlib
+cleanobj:
+ rm -f $(CHOLRL) $(CHOLTOP) $(LUCR) $(LULL) $(LUREC) $(QRLL)
+cleanlib:
+ rm -f *.a
.f.o:
$(FORTRAN) $(OPTS) -c -o $@ $<
-
-clean:
- rm -f $(CHOLRL) $(CHOLTOP) $(LUCR) $(LULL) $(LUREC) $(QRLL) \
- $(VARIANTSDIR)/*.a
- ===============
- = README File =
+ ===============
+ = README File =
===============
This README File is for the LAPACK driver variants.
=========
These variants are compiled by default in the build process but they are not tested by default.
-The build process creates one new library per variants in the four arithmetics (singel/double/comple/double complex).
-The libraries are in the SRC/VARIANTS/LIB directory.
+The build process creates one new library per variants in the four arithmetics (single real/double real/single complex/double complex).
+The libraries are in the SRC/VARIANTS directory.
-Corresponding libraries created in SRC/VARIANTS/LIB:
+Corresponding libraries created in SRC/VARIANTS:
- LU Crout : lucr.a
- LU Left Looking : lull.a
- LU Sivan Toledo's recursive : lurec.a
Using LU Left Looking version:
$(FORTRAN) -c myprog.f
- $(FORTRAN) -o myexe myprog.o $(PATH TO LAPACK/SRC/VARIANTS/LIB)/lull.a $(LAPACKLIB) $(BLASLIB)
+ $(FORTRAN) -o myexe myprog.o $(PATH TO LAPACK/SRC/VARIANTS)/lull.a $(LAPACKLIB) $(BLASLIB)
===========
= SUPPORT =
*>
*> \param[in,out] V2T
*> \verbatim
-*> V2T is COMPLEX array, dimenison (LDV2T,M-Q)
+*> V2T is COMPLEX array, dimension (LDV2T,M-Q)
*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is
*> premultiplied by the conjugate transpose of the right
*> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and
$ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E,
$ B22D, B22E, RWORK, LRWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is COMPLEX array dimension (min(M,N))
+*> TAUQ is COMPLEX array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the unitary matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexGEcomputational
* @precisions normal c -> s d z
* =====================================================================
SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is COMPLEX array dimension (min(M,N))
+*> TAUQ is COMPLEX array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the unitary matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexGEcomputational
*
SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
- $ NBMIN, NX
- REAL WS
+ $ NBMIN, NX, WS
* ..
* .. External Subroutines ..
EXTERNAL CGEBD2, CGEMM, CLABRD, XERBLA
* .. Scalar Arguments ..
* CHARACTER BALANC, JOBVL, JOBVR, SENSE
* INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
-* REAL ABNRM
+* REAL ABNRM
* ..
* .. Array Arguments ..
-* REAL RCONDE( * ), RCONDV( * ), RWORK( * ),
+* REAL RCONDE( * ), RCONDV( * ), RWORK( * ),
* $ SCALE( * )
-* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
+* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
* $ W( * ), WORK( * )
* ..
*
$ RCONDV, WORK, LWORK, RWORK, INFO )
implicit none
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
- REAL ABNRM
+ REAL ABNRM
* ..
* .. Array Arguments ..
- REAL RCONDE( * ), RCONDV( * ), RWORK( * ),
+ REAL RCONDE( * ), RCONDV( * ), RWORK( * ),
$ SCALE( * )
- COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
+ COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
$ W( * ), WORK( * )
* ..
*
* =====================================================================
*
* .. Parameters ..
- REAL ZERO, ONE
+ REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
* ..
* .. Local Scalars ..
CHARACTER JOB, SIDE
INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K,
$ LWORK_TREVC, MAXWRK, MINWRK, NOUT
- REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
- COMPLEX TMP
+ REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
+ COMPLEX TMP
* ..
* .. Local Arrays ..
LOGICAL SELECT( 1 )
-*> \brief \b CGEJSV\r
-*\r
-* =========== DOCUMENTATION ===========\r
-*\r
-* Online html documentation available at\r
-* http://www.netlib.org/lapack/explore-html/\r
-*\r
-*> \htmlonly\r
-*> Download CGEJSV + dependencies\r
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgejsv.f">\r
-*> [TGZ]</a>\r
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgejsv.f">\r
-*> [ZIP]</a>\r
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgejsv.f">\r
-*> [TXT]</a>\r
-*> \endhtmlonly\r
-*\r
-* Definition:\r
-* ===========\r
-*\r
-* SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,\r
-* M, N, A, LDA, SVA, U, LDU, V, LDV,\r
-* CWORK, LWORK, RWORK, LRWORK, IWORK, INFO )\r
-*\r
-* .. Scalar Arguments ..\r
-* IMPLICIT NONE\r
-* INTEGER INFO, LDA, LDU, LDV, LWORK, M, N\r
-* ..\r
-* .. Array Arguments ..\r
-* COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK )\r
-* REAL SVA( N ), RWORK( LRWORK )\r
-* INTEGER IWORK( * )\r
-* CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV\r
-* ..\r
-*\r
-*\r
-*> \par Purpose:\r
-* =============\r
-*>\r
-*> \verbatim\r
-*>\r
-*> CGEJSV computes the singular value decomposition (SVD) of a complex M-by-N\r
-*> matrix [A], where M >= N. The SVD of [A] is written as\r
-*>\r
-*> [A] = [U] * [SIGMA] * [V]^*,\r
-*>\r
-*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N\r
-*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and\r
-*> [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are\r
-*> the singular values of [A]. The columns of [U] and [V] are the left and\r
-*> the right singular vectors of [A], respectively. The matrices [U] and [V]\r
-*> are computed and stored in the arrays U and V, respectively. The diagonal\r
-*> of [SIGMA] is computed and stored in the array SVA.\r
-*> \endverbatim\r
-*>\r
-*> Arguments:\r
-*> ==========\r
-*>\r
-*> \param[in] JOBA\r
-*> \verbatim\r
-*> JOBA is CHARACTER*1\r
-*> Specifies the level of accuracy:\r
-*> = 'C': This option works well (high relative accuracy) if A = B * D,\r
-*> with well-conditioned B and arbitrary diagonal matrix D.\r
-*> The accuracy cannot be spoiled by COLUMN scaling. The\r
-*> accuracy of the computed output depends on the condition of\r
-*> B, and the procedure aims at the best theoretical accuracy.\r
-*> The relative error max_{i=1:N}|d sigma_i| / sigma_i is\r
-*> bounded by f(M,N)*epsilon* cond(B), independent of D.\r
-*> The input matrix is preprocessed with the QRF with column\r
-*> pivoting. This initial preprocessing and preconditioning by\r
-*> a rank revealing QR factorization is common for all values of\r
-*> JOBA. Additional actions are specified as follows:\r
-*> = 'E': Computation as with 'C' with an additional estimate of the\r
-*> condition number of B. It provides a realistic error bound.\r
-*> = 'F': If A = D1 * C * D2 with ill-conditioned diagonal scalings\r
-*> D1, D2, and well-conditioned matrix C, this option gives\r
-*> higher accuracy than the 'C' option. If the structure of the\r
-*> input matrix is not known, and relative accuracy is\r
-*> desirable, then this option is advisable. The input matrix A\r
-*> is preprocessed with QR factorization with FULL (row and\r
-*> column) pivoting.\r
-*> = 'G' Computation as with 'F' with an additional estimate of the\r
-*> condition number of B, where A=B*D. If A has heavily weighted\r
-*> rows, then using this condition number gives too pessimistic\r
-*> error bound.\r
-*> = 'A': Small singular values are not well determined by the data \r
-*> and are considered as noisy; the matrix is treated as\r
-*> numerically rank defficient. The error in the computed\r
-*> singular values is bounded by f(m,n)*epsilon*||A||.\r
-*> The computed SVD A = U * S * V^* restores A up to\r
-*> f(m,n)*epsilon*||A||.\r
-*> This gives the procedure the licence to discard (set to zero)\r
-*> all singular values below N*epsilon*||A||.\r
-*> = 'R': Similar as in 'A'. Rank revealing property of the initial\r
-*> QR factorization is used do reveal (using triangular factor)\r
-*> a gap sigma_{r+1} < epsilon * sigma_r in which case the\r
-*> numerical RANK is declared to be r. The SVD is computed with\r
-*> absolute error bounds, but more accurately than with 'A'.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBU\r
-*> \verbatim\r
-*> JOBU is CHARACTER*1\r
-*> Specifies whether to compute the columns of U:\r
-*> = 'U': N columns of U are returned in the array U.\r
-*> = 'F': full set of M left sing. vectors is returned in the array U.\r
-*> = 'W': U may be used as workspace of length M*N. See the description\r
-*> of U.\r
-*> = 'N': U is not computed.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBV\r
-*> \verbatim\r
-*> JOBV is CHARACTER*1\r
-*> Specifies whether to compute the matrix V:\r
-*> = 'V': N columns of V are returned in the array V; Jacobi rotations\r
-*> are not explicitly accumulated.\r
-*> = 'J': N columns of V are returned in the array V, but they are\r
-*> computed as the product of Jacobi rotations, if JOBT .EQ. 'N'.\r
-*> = 'W': V may be used as workspace of length N*N. See the description\r
-*> of V.\r
-*> = 'N': V is not computed.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBR\r
-*> \verbatim\r
-*> JOBR is CHARACTER*1\r
-*> Specifies the RANGE for the singular values. Issues the licence to\r
-*> set to zero small positive singular values if they are outside\r
-*> specified range. If A .NE. 0 is scaled so that the largest singular\r
-*> value of c*A is around SQRT(BIG), BIG=SLAMCH('O'), then JOBR issues\r
-*> the licence to kill columns of A whose norm in c*A is less than\r
-*> SQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN,\r
-*> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E').\r
-*> = 'N': Do not kill small columns of c*A. This option assumes that\r
-*> BLAS and QR factorizations and triangular solvers are\r
-*> implemented to work in that range. If the condition of A\r
-*> is greater than BIG, use CGESVJ.\r
-*> = 'R': RESTRICTED range for sigma(c*A) is [SQRT(SFMIN), SQRT(BIG)]\r
-*> (roughly, as described above). This option is recommended.\r
-*> ===========================\r
-*> For computing the singular values in the FULL range [SFMIN,BIG]\r
-*> use CGESVJ.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBT\r
-*> \verbatim\r
-*> JOBT is CHARACTER*1\r
-*> If the matrix is square then the procedure may determine to use\r
-*> transposed A if A^* seems to be better with respect to convergence.\r
-*> If the matrix is not square, JOBT is ignored.\r
-*> The decision is based on two values of entropy over the adjoint\r
-*> orbit of A^* * A. See the descriptions of WORK(6) and WORK(7).\r
-*> = 'T': transpose if entropy test indicates possibly faster\r
-*> convergence of Jacobi process if A^* is taken as input. If A is\r
-*> replaced with A^*, then the row pivoting is included automatically.\r
-*> = 'N': do not speculate.\r
-*> The option 'T' can be used to compute only the singular values, or\r
-*> the full SVD (U, SIGMA and V). For only one set of singular vectors\r
-*> (U or V), the caller should provide both U and V, as one of the\r
-*> matrices is used as workspace if the matrix A is transposed.\r
-*> The implementer can easily remove this constraint and make the\r
-*> code more complicated. See the descriptions of U and V.\r
-*> In general, this option is considered experimental, and 'N'; should\r
-*> be preferred. This is subject to changes in the future.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBP\r
-*> \verbatim\r
-*> JOBP is CHARACTER*1\r
-*> Issues the licence to introduce structured perturbations to drown\r
-*> denormalized numbers. This licence should be active if the\r
-*> denormals are poorly implemented, causing slow computation,\r
-*> especially in cases of fast convergence (!). For details see [1,2].\r
-*> For the sake of simplicity, this perturbations are included only\r
-*> when the full SVD or only the singular values are requested. The\r
-*> implementer/user can easily add the perturbation for the cases of\r
-*> computing one set of singular vectors.\r
-*> = 'P': introduce perturbation\r
-*> = 'N': do not perturb\r
-*> \endverbatim\r
-*>\r
-*> \param[in] M\r
-*> \verbatim\r
-*> M is INTEGER\r
-*> The number of rows of the input matrix A. M >= 0.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] N\r
-*> \verbatim\r
-*> N is INTEGER\r
-*> The number of columns of the input matrix A. M >= N >= 0.\r
-*> \endverbatim\r
-*>\r
-*> \param[in,out] A\r
-*> \verbatim\r
-*> A is COMPLEX array, dimension (LDA,N)\r
-*> On entry, the M-by-N matrix A.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LDA\r
-*> \verbatim\r
-*> LDA is INTEGER\r
-*> The leading dimension of the array A. LDA >= max(1,M).\r
-*> \endverbatim\r
-*>\r
-*> \param[out] SVA\r
-*> \verbatim\r
-*> SVA is REAL array, dimension (N)\r
-*> On exit,\r
-*> - For WORK(1)/WORK(2) = ONE: The singular values of A. During the\r
-*> computation SVA contains Euclidean column norms of the\r
-*> iterated matrices in the array A.\r
-*> - For WORK(1) .NE. WORK(2): The singular values of A are\r
-*> (WORK(1)/WORK(2)) * SVA(1:N). This factored form is used if\r
-*> sigma_max(A) overflows or if small singular values have been\r
-*> saved from underflow by scaling the input matrix A.\r
-*> - If JOBR='R' then some of the singular values may be returned\r
-*> as exact zeros obtained by "set to zero" because they are\r
-*> below the numerical rank threshold or are denormalized numbers.\r
-*> \endverbatim\r
-*>\r
-*> \param[out] U\r
-*> \verbatim\r
-*> U is COMPLEX array, dimension ( LDU, N ) or ( LDU, M )\r
-*> If JOBU = 'U', then U contains on exit the M-by-N matrix of\r
-*> the left singular vectors.\r
-*> If JOBU = 'F', then U contains on exit the M-by-M matrix of\r
-*> the left singular vectors, including an ONB\r
-*> of the orthogonal complement of the Range(A).\r
-*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N),\r
-*> then U is used as workspace if the procedure\r
-*> replaces A with A^*. In that case, [V] is computed\r
-*> in U as left singular vectors of A^* and then\r
-*> copied back to the V array. This 'W' option is just\r
-*> a reminder to the caller that in this case U is\r
-*> reserved as workspace of length N*N.\r
-*> If JOBU = 'N' U is not referenced, unless JOBT='T'.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LDU\r
-*> \verbatim\r
-*> LDU is INTEGER\r
-*> The leading dimension of the array U, LDU >= 1.\r
-*> IF JOBU = 'U' or 'F' or 'W', then LDU >= M.\r
-*> \endverbatim\r
-*>\r
-*> \param[out] V\r
-*> \verbatim\r
-*> V is COMPLEX array, dimension ( LDV, N )\r
-*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of\r
-*> the right singular vectors;\r
-*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N),\r
-*> then V is used as workspace if the pprocedure\r
-*> replaces A with A^*. In that case, [U] is computed\r
-*> in V as right singular vectors of A^* and then\r
-*> copied back to the U array. This 'W' option is just\r
-*> a reminder to the caller that in this case V is\r
-*> reserved as workspace of length N*N.\r
-*> If JOBV = 'N' V is not referenced, unless JOBT='T'.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LDV\r
-*> \verbatim\r
-*> LDV is INTEGER\r
-*> The leading dimension of the array V, LDV >= 1.\r
-*> If JOBV = 'V' or 'J' or 'W', then LDV >= N.\r
-*> \endverbatim\r
-*>\r
-*> \param[out] CWORK\r
-*> \verbatim\r
-*> CWORK is COMPLEX array, dimension (MAX(2,LWORK))\r
-*> If the call to CGEJSV is a workspace query (indicated by LWORK=-1 or\r
-*> LRWORK=-1), then on exit CWORK(1) contains the required length of \r
-*> CWORK for the job parameters used in the call.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LWORK\r
-*> \verbatim\r
-*> LWORK is INTEGER\r
-*> Length of CWORK to confirm proper allocation of workspace.\r
-*> LWORK depends on the job:\r
-*>\r
-*> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and\r
-*> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'):\r
-*> LWORK >= 2*N+1. This is the minimal requirement.\r
-*> ->> For optimal performance (blocked code) the optimal value\r
-*> is LWORK >= N + (N+1)*NB. Here NB is the optimal\r
-*> block size for CGEQP3 and CGEQRF.\r
-*> In general, optimal LWORK is computed as\r
-*> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CGEQRF), LWORK(CGESVJ)). \r
-*> 1.2. .. an estimate of the scaled condition number of A is\r
-*> required (JOBA='E', or 'G'). In this case, LWORK the minimal\r
-*> requirement is LWORK >= N*N + 2*N.\r
-*> ->> For optimal performance (blocked code) the optimal value\r
-*> is LWORK >= max(N+(N+1)*NB, N*N+2*N)=N**2+2*N.\r
-*> In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CGEQRF), LWORK(CGESVJ),\r
-*> N*N+LWORK(CPOCON)).\r
-*> 2. If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'),\r
-*> (JOBU.EQ.'N')\r
-*> 2.1 .. no scaled condition estimate requested (JOBE.EQ.'N'): \r
-*> -> the minimal requirement is LWORK >= 3*N.\r
-*> -> For optimal performance, \r
-*> LWORK >= max(N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,\r
-*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQ,\r
-*> CUNMLQ. In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(CGEQP3), N+LWORK(CGESVJ),\r
-*> N+LWORK(CGELQF), 2*N+LWORK(CGEQRF), N+LWORK(CUNMLQ)).\r
-*> 2.2 .. an estimate of the scaled condition number of A is\r
-*> required (JOBA='E', or 'G').\r
-*> -> the minimal requirement is LWORK >= 3*N. \r
-*> -> For optimal performance, \r
-*> LWORK >= max(N+(N+1)*NB, 2*N,2*N+N*NB)=2*N+N*NB,\r
-*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQ,\r
-*> CUNMLQ. In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(CGEQP3), LWORK(CPOCON), N+LWORK(CGESVJ),\r
-*> N+LWORK(CGELQF), 2*N+LWORK(CGEQRF), N+LWORK(CUNMLQ)). \r
-*> 3. If SIGMA and the left singular vectors are needed\r
-*> 3.1 .. no scaled condition estimate requested (JOBE.EQ.'N'):\r
-*> -> the minimal requirement is LWORK >= 3*N.\r
-*> -> For optimal performance:\r
-*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,\r
-*> where NB is the optimal block size for CGEQP3, CGEQRF, CUNMQR.\r
-*> In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(CGEQP3), 2*N+LWORK(CGEQRF), N+LWORK(CUNMQR)). \r
-*> 3.2 .. an estimate of the scaled condition number of A is\r
-*> required (JOBA='E', or 'G').\r
-*> -> the minimal requirement is LWORK >= 3*N.\r
-*> -> For optimal performance:\r
-*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,\r
-*> where NB is the optimal block size for CGEQP3, CGEQRF, CUNMQR.\r
-*> In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CPOCON),\r
-*> 2*N+LWORK(CGEQRF), N+LWORK(CUNMQR)).\r
-*>\r
-*> 4. If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and\r
-*> 4.1. if JOBV.EQ.'V'\r
-*> the minimal requirement is LWORK >= 5*N+2*N*N.\r
-*> 4.2. if JOBV.EQ.'J' the minimal requirement is\r
-*> LWORK >= 4*N+N*N.\r
-*> In both cases, the allocated CWORK can accommodate blocked runs\r
-*> of CGEQP3, CGEQRF, CGELQF, CUNMQR, CUNMLQ.\r
-*> \r
-*> If the call to CGEJSV is a workspace query (indicated by LWORK=-1 or\r
-*> LRWORK=-1), then on exit CWORK(1) contains the optimal and CWORK(2) contains the\r
-*> minimal length of CWORK for the job parameters used in the call. \r
-*> \endverbatim\r
-*>\r
-*> \param[out] RWORK\r
-*> \verbatim\r
-*> RWORK is REAL array, dimension (MAX(7,LWORK))\r
-*> On exit,\r
-*> RWORK(1) = Determines the scaling factor SCALE = RWORK(2) / RWORK(1)\r
-*> such that SCALE*SVA(1:N) are the computed singular values\r
-*> of A. (See the description of SVA().)\r
-*> RWORK(2) = See the description of RWORK(1).\r
-*> RWORK(3) = SCONDA is an estimate for the condition number of\r
-*> column equilibrated A. (If JOBA .EQ. 'E' or 'G')\r
-*> SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1).\r
-*> It is computed using SPOCON. It holds\r
-*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA\r
-*> where R is the triangular factor from the QRF of A.\r
-*> However, if R is truncated and the numerical rank is\r
-*> determined to be strictly smaller than N, SCONDA is\r
-*> returned as -1, thus indicating that the smallest\r
-*> singular values might be lost.\r
-*>\r
-*> If full SVD is needed, the following two condition numbers are\r
-*> useful for the analysis of the algorithm. They are provied for\r
-*> a developer/implementer who is familiar with the details of\r
-*> the method.\r
-*>\r
-*> RWORK(4) = an estimate of the scaled condition number of the\r
-*> triangular factor in the first QR factorization.\r
-*> RWORK(5) = an estimate of the scaled condition number of the\r
-*> triangular factor in the second QR factorization.\r
-*> The following two parameters are computed if JOBT .EQ. 'T'.\r
-*> They are provided for a developer/implementer who is familiar\r
-*> with the details of the method.\r
-*> RWORK(6) = the entropy of A^* * A :: this is the Shannon entropy\r
-*> of diag(A^* * A) / Trace(A^* * A) taken as point in the\r
-*> probability simplex.\r
-*> RWORK(7) = the entropy of A * A^*. (See the description of RWORK(6).)\r
-*> If the call to CGEJSV is a workspace query (indicated by LWORK=-1 or\r
-*> LRWORK=-1), then on exit RWORK(1) contains the required length of\r
-*> RWORK for the job parameters used in the call.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LRWORK\r
-*> \verbatim\r
-*> LRWORK is INTEGER\r
-*> Length of RWORK to confirm proper allocation of workspace.\r
-*> LRWORK depends on the job:\r
-*>\r
-*> 1. If only the singular values are requested i.e. if\r
-*> LSAME(JOBU,'N') .AND. LSAME(JOBV,'N')\r
-*> then:\r
-*> 1.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),\r
-*> then: LRWORK = max( 7, 2 * M ).\r
-*> 1.2. Otherwise, LRWORK = max( 7, N ).\r
-*> 2. If singular values with the right singular vectors are requested\r
-*> i.e. if\r
-*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) .AND.\r
-*> .NOT.(LSAME(JOBU,'U').OR.LSAME(JOBU,'F'))\r
-*> then:\r
-*> 2.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),\r
-*> then LRWORK = max( 7, 2 * M ).\r
-*> 2.2. Otherwise, LRWORK = max( 7, N ).\r
-*> 3. If singular values with the left singular vectors are requested, i.e. if\r
-*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND.\r
-*> .NOT.(LSAME(JOBV,'V').OR.LSAME(JOBV,'J'))\r
-*> then:\r
-*> 3.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),\r
-*> then LRWORK = max( 7, 2 * M ).\r
-*> 3.2. Otherwise, LRWORK = max( 7, N ).\r
-*> 4. If singular values with both the left and the right singular vectors\r
-*> are requested, i.e. if\r
-*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND.\r
-*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J'))\r
-*> then:\r
-*> 4.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),\r
-*> then LRWORK = max( 7, 2 * M ).\r
-*> 4.2. Otherwise, LRWORK = max( 7, N ).\r
-*> \r
-*> If, on entry, LRWORK = -1 or LWORK=-1, a workspace query is assumed and \r
-*> the length of RWORK is returned in RWORK(1). \r
-*> \endverbatim\r
-*>\r
-*> \param[out] IWORK\r
-*> \verbatim\r
-*> IWORK is INTEGER array, of dimension at least 4, that further depends\r
-*> on the job:\r
-*> \r
-*> 1. If only the singular values are requested then:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is N+M; otherwise the length of IWORK is N.\r
-*> 2. If the singular values and the right singular vectors are requested then:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is N+M; otherwise the length of IWORK is N. \r
-*> 3. If the singular values and the left singular vectors are requested then:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is N+M; otherwise the length of IWORK is N. \r
-*> 4. If the singular values with both the left and the right singular vectors\r
-*> are requested, then: \r
-*> 4.1. If LSAME(JOBV,'J') the length of IWORK is determined as follows:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is N+M; otherwise the length of IWORK is N. \r
-*> 4.2. If LSAME(JOBV,'V') the length of IWORK is determined as follows:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is 2*N+M; otherwise the length of IWORK is 2*N.\r
-*> \r
-*> On exit,\r
-*> IWORK(1) = the numerical rank determined after the initial\r
-*> QR factorization with pivoting. See the descriptions\r
-*> of JOBA and JOBR.\r
-*> IWORK(2) = the number of the computed nonzero singular values\r
-*> IWORK(3) = if nonzero, a warning message:\r
-*> If IWORK(3).EQ.1 then some of the column norms of A\r
-*> were denormalized floats. The requested high accuracy\r
-*> is not warranted by the data.\r
-*> IWORK(4) = 1 or -1. If IWORK(4) .EQ. 1, then the procedure used A^* to\r
-*> do the job as specified by the JOB parameters.\r
-*> If the call to CGEJSV is a workspace query (indicated by LWORK .EQ. -1 and \r
-*> LRWORK .EQ. -1), then on exit IWORK(1) contains the required length of \r
-*> IWORK for the job parameters used in the call.\r
-*> \endverbatim\r
-*>\r
-*> \param[out] INFO\r
-*> \verbatim\r
-*> INFO is INTEGER\r
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value.\r
-*> = 0 : successful exit;\r
-*> > 0 : CGEJSV did not converge in the maximal allowed number\r
-*> of sweeps. The computed values may be inaccurate.\r
-*> \endverbatim\r
-*\r
-* Authors:\r
-* ========\r
-*\r
-*> \author Univ. of Tennessee\r
-*> \author Univ. of California Berkeley\r
-*> \author Univ. of Colorado Denver\r
-*> \author NAG Ltd.\r
-*\r
-*> \date June 2016\r
-*\r
-*> \ingroup complexGEsing\r
-*\r
-*> \par Further Details:\r
-* =====================\r
-*>\r
-*> \verbatim\r
-*> CGEJSV implements a preconditioned Jacobi SVD algorithm. It uses CGEQP3,\r
-*> CGEQRF, and CGELQF as preprocessors and preconditioners. Optionally, an\r
-*> additional row pivoting can be used as a preprocessor, which in some\r
-*> cases results in much higher accuracy. An example is matrix A with the\r
-*> structure A = D1 * C * D2, where D1, D2 are arbitrarily ill-conditioned\r
-*> diagonal matrices and C is well-conditioned matrix. In that case, complete\r
-*> pivoting in the first QR factorizations provides accuracy dependent on the\r
-*> condition number of C, and independent of D1, D2. Such higher accuracy is\r
-*> not completely understood theoretically, but it works well in practice.\r
-*> Further, if A can be written as A = B*D, with well-conditioned B and some\r
-*> diagonal D, then the high accuracy is guaranteed, both theoretically and\r
-*> in software, independent of D. For more details see [1], [2].\r
-*> The computational range for the singular values can be the full range\r
-*> ( UNDERFLOW,OVERFLOW ), provided that the machine arithmetic and the BLAS\r
-*> & LAPACK routines called by CGEJSV are implemented to work in that range.\r
-*> If that is not the case, then the restriction for safe computation with\r
-*> the singular values in the range of normalized IEEE numbers is that the\r
-*> spectral condition number kappa(A)=sigma_max(A)/sigma_min(A) does not\r
-*> overflow. This code (CGEJSV) is best used in this restricted range,\r
-*> meaning that singular values of magnitude below ||A||_2 / SLAMCH('O') are\r
-*> returned as zeros. See JOBR for details on this.\r
-*> Further, this implementation is somewhat slower than the one described\r
-*> in [1,2] due to replacement of some non-LAPACK components, and because\r
-*> the choice of some tuning parameters in the iterative part (CGESVJ) is\r
-*> left to the implementer on a particular machine.\r
-*> The rank revealing QR factorization (in this code: CGEQP3) should be\r
-*> implemented as in [3]. We have a new version of CGEQP3 under development\r
-*> that is more robust than the current one in LAPACK, with a cleaner cut in\r
-*> rank deficient cases. It will be available in the SIGMA library [4].\r
-*> If M is much larger than N, it is obvious that the initial QRF with\r
-*> column pivoting can be preprocessed by the QRF without pivoting. That\r
-*> well known trick is not used in CGEJSV because in some cases heavy row\r
-*> weighting can be treated with complete pivoting. The overhead in cases\r
-*> M much larger than N is then only due to pivoting, but the benefits in\r
-*> terms of accuracy have prevailed. The implementer/user can incorporate\r
-*> this extra QRF step easily. The implementer can also improve data movement\r
-*> (matrix transpose, matrix copy, matrix transposed copy) - this\r
-*> implementation of CGEJSV uses only the simplest, naive data movement.\r
-*> \endverbatim\r
-*\r
-*> \par Contributor:\r
-* ==================\r
-*>\r
-*> Zlatko Drmac (Zagreb, Croatia)\r
-*\r
-*> \par References:\r
-* ================\r
-*>\r
-*> \verbatim\r
-*>\r
-*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I.\r
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342.\r
-*> LAPACK Working note 169.\r
-*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II.\r
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362.\r
-*> LAPACK Working note 170.\r
-*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR\r
-*> factorization software - a case study.\r
-*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28.\r
-*> LAPACK Working note 176.\r
-*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV,\r
-*> QSVD, (H,K)-SVD computations.\r
-*> Department of Mathematics, University of Zagreb, 2008, 2016.\r
-*> \endverbatim\r
-*\r
-*> \par Bugs, examples and comments:\r
-* =================================\r
-*>\r
-*> Please report all bugs and send interesting examples and/or comments to\r
-*> drmac@math.hr. Thank you.\r
-*>\r
-* =====================================================================\r
- SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,\r
- $ M, N, A, LDA, SVA, U, LDU, V, LDV,\r
- $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO )\r
-*\r
-* -- LAPACK computational routine (version 3.7.0) --\r
-* -- LAPACK is a software package provided by Univ. of Tennessee, --\r
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--\r
-* December 2016\r
-*\r
-* .. Scalar Arguments ..\r
- IMPLICIT NONE\r
- INTEGER INFO, LDA, LDU, LDV, LWORK, LRWORK, M, N\r
-* ..\r
-* .. Array Arguments ..\r
- COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK )\r
- REAL SVA( N ), RWORK( LRWORK )\r
- INTEGER IWORK( * )\r
- CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV\r
-* ..\r
-*\r
-* ===========================================================================\r
-*\r
-* .. Local Parameters ..\r
- REAL ZERO, ONE\r
- PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )\r
- COMPLEX CZERO, CONE\r
- PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ), CONE = ( 1.0E0, 0.0E0 ) )\r
-* ..\r
-* .. Local Scalars ..\r
- COMPLEX CTEMP\r
- REAL AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1, COND_OK,\r
- $ CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN, MAXPRJ, SCALEM,\r
- $ SCONDA, SFMIN, SMALL, TEMP1, USCAL1, USCAL2, XSC\r
- INTEGER IERR, N1, NR, NUMRANK, p, q, WARNING\r
- LOGICAL ALMORT, DEFR, ERREST, GOSCAL, JRACC, KILL, LQUERY,\r
- $ LSVEC, L2ABER, L2KILL, L2PERT, L2RANK, L2TRAN, NOSCAL,\r
- $ ROWPIV, RSVEC, TRANSP\r
-*\r
- INTEGER OPTWRK, MINWRK, MINRWRK, MINIWRK\r
- INTEGER LWCON, LWLQF, LWQP3, LWQRF, LWUNMLQ, LWUNMQR, LWUNMQRM,\r
- $ LWSVDJ, LWSVDJV, LRWQP3, LRWCON, LRWSVDJ, IWOFF\r
- INTEGER LWRK_CGELQF, LWRK_CGEQP3, LWRK_CGEQP3N, LWRK_CGEQRF, \r
- $ LWRK_CGESVJ, LWRK_CGESVJV, LWRK_CGESVJU, LWRK_CUNMLQ, \r
- $ LWRK_CUNMQR, LWRK_CUNMQRM \r
-* ..\r
-* .. Local Arrays\r
- COMPLEX CDUMMY(1)\r
- REAL RDUMMY(1)\r
-*\r
-* .. Intrinsic Functions ..\r
- INTRINSIC ABS, CMPLX, CONJG, ALOG, MAX, MIN, REAL, NINT, SQRT\r
-* ..\r
-* .. External Functions ..\r
- REAL SLAMCH, SCNRM2\r
- INTEGER ISAMAX, ICAMAX\r
- LOGICAL LSAME\r
- EXTERNAL ISAMAX, ICAMAX, LSAME, SLAMCH, SCNRM2\r
-* ..\r
-* .. External Subroutines ..\r
- EXTERNAL SLASSQ, CCOPY, CGELQF, CGEQP3, CGEQRF, CLACPY, CLAPMR,\r
- $ CLASCL, SLASCL, CLASET, CLASSQ, CLASWP, CUNGQR, CUNMLQ,\r
- $ CUNMQR, CPOCON, SSCAL, CSSCAL, CSWAP, CTRSM, CLACGV,\r
- $ XERBLA\r
-*\r
- EXTERNAL CGESVJ\r
-* ..\r
-*\r
-* Test the input arguments\r
-*\r
- LSVEC = LSAME( JOBU, 'U' ) .OR. LSAME( JOBU, 'F' )\r
- JRACC = LSAME( JOBV, 'J' )\r
- RSVEC = LSAME( JOBV, 'V' ) .OR. JRACC\r
- ROWPIV = LSAME( JOBA, 'F' ) .OR. LSAME( JOBA, 'G' )\r
- L2RANK = LSAME( JOBA, 'R' )\r
- L2ABER = LSAME( JOBA, 'A' )\r
- ERREST = LSAME( JOBA, 'E' ) .OR. LSAME( JOBA, 'G' )\r
- L2TRAN = LSAME( JOBT, 'T' ) .AND. ( M .EQ. N )\r
- L2KILL = LSAME( JOBR, 'R' )\r
- DEFR = LSAME( JOBR, 'N' )\r
- L2PERT = LSAME( JOBP, 'P' )\r
-*\r
- LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 )\r
-*\r
- IF ( .NOT.(ROWPIV .OR. L2RANK .OR. L2ABER .OR.\r
- $ ERREST .OR. LSAME( JOBA, 'C' ) )) THEN\r
- INFO = - 1\r
- ELSE IF ( .NOT.( LSVEC .OR. LSAME( JOBU, 'N' ) .OR.\r
- $ ( LSAME( JOBU, 'W' ) .AND. RSVEC .AND. L2TRAN ) ) ) THEN\r
- INFO = - 2\r
- ELSE IF ( .NOT.( RSVEC .OR. LSAME( JOBV, 'N' ) .OR.\r
- $ ( LSAME( JOBV, 'W' ) .AND. LSVEC .AND. L2TRAN ) ) ) THEN\r
- INFO = - 3\r
- ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN\r
- INFO = - 4\r
- ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. LSAME(JOBT,'N') ) ) THEN\r
- INFO = - 5\r
- ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN\r
- INFO = - 6\r
- ELSE IF ( M .LT. 0 ) THEN\r
- INFO = - 7\r
- ELSE IF ( ( N .LT. 0 ) .OR. ( N .GT. M ) ) THEN\r
- INFO = - 8\r
- ELSE IF ( LDA .LT. M ) THEN\r
- INFO = - 10\r
- ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN\r
- INFO = - 13\r
- ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN\r
- INFO = - 15\r
- ELSE\r
-* #:)\r
- INFO = 0\r
- END IF\r
-*\r
- IF ( INFO .EQ. 0 ) THEN \r
-* .. compute the minimal and the optimal workspace lengths \r
-* [[The expressions for computing the minimal and the optimal\r
-* values of LCWORK, LRWORK are written with a lot of redundancy and\r
-* can be simplified. However, this verbose form is useful for\r
-* maintenance and modifications of the code.]]\r
-*\r
-* .. minimal workspace length for CGEQP3 of an M x N matrix,\r
-* CGEQRF of an N x N matrix, CGELQF of an N x N matrix,\r
-* CUNMLQ for computing N x N matrix, CUNMQR for computing N x N\r
-* matrix, CUNMQR for computing M x N matrix, respectively.\r
- LWQP3 = N+1 \r
- LWQRF = MAX( 1, N )\r
- LWLQF = MAX( 1, N )\r
- LWUNMLQ = MAX( 1, N )\r
- LWUNMQR = MAX( 1, N )\r
- LWUNMQRM = MAX( 1, M )\r
-* .. minimal workspace length for CPOCON of an N x N matrix\r
- LWCON = 2 * N \r
-* .. minimal workspace length for CGESVJ of an N x N matrix,\r
-* without and with explicit accumulation of Jacobi rotations\r
- LWSVDJ = MAX( 2 * N, 1 ) \r
- LWSVDJV = MAX( 2 * N, 1 )\r
-* .. minimal REAL workspace length for CGEQP3, CPOCON, CGESVJ\r
- LRWQP3 = N \r
- LRWCON = N \r
- LRWSVDJ = N \r
- IF ( LQUERY ) THEN \r
- CALL CGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, \r
- $ RDUMMY, IERR )\r
- LWRK_CGEQP3 = CDUMMY(1)\r
- CALL CGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )\r
- LWRK_CGEQRF = CDUMMY(1)\r
- CALL CGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )\r
- LWRK_CGELQF = CDUMMY(1) \r
- END IF\r
- MINWRK = 2\r
- OPTWRK = 2\r
- MINIWRK = N \r
- IF ( .NOT. (LSVEC .OR. RSVEC ) ) THEN\r
-* .. minimal and optimal sizes of the complex workspace if\r
-* only the singular values are requested\r
- IF ( ERREST ) THEN \r
- MINWRK = MAX( N+LWQP3, N**2+LWCON, N+LWQRF, LWSVDJ )\r
- ELSE\r
- MINWRK = MAX( N+LWQP3, N+LWQRF, LWSVDJ )\r
- END IF\r
- IF ( LQUERY ) THEN \r
- CALL CGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, \r
- $ LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_CGESVJ = CDUMMY(1)\r
- IF ( ERREST ) THEN \r
- OPTWRK = MAX( N+LWRK_CGEQP3, N**2+LWCON, \r
- $ N+LWRK_CGEQRF, LWRK_CGESVJ )\r
- ELSE\r
- OPTWRK = MAX( N+LWRK_CGEQP3, N+LWRK_CGEQRF, \r
- $ LWRK_CGESVJ )\r
- END IF\r
- END IF\r
- IF ( L2TRAN .OR. ROWPIV ) THEN \r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWCON, LRWSVDJ )\r
- ELSE\r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )\r
- END IF \r
- ELSE\r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, LRWQP3, LRWCON, LRWSVDJ )\r
- ELSE\r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )\r
- END IF\r
- END IF \r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M \r
- ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN\r
-* .. minimal and optimal sizes of the complex workspace if the\r
-* singular values and the right singular vectors are requested\r
- IF ( ERREST ) THEN \r
- MINWRK = MAX( N+LWQP3, LWCON, LWSVDJ, N+LWLQF, \r
- $ 2*N+LWQRF, N+LWSVDJ, N+LWUNMLQ )\r
- ELSE\r
- MINWRK = MAX( N+LWQP3, LWSVDJ, N+LWLQF, 2*N+LWQRF, \r
- $ N+LWSVDJ, N+LWUNMLQ )\r
- END IF\r
- IF ( LQUERY ) THEN\r
- CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,\r
- $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_CGESVJ = CDUMMY(1)\r
- CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,\r
- $ V, LDV, CDUMMY, -1, IERR )\r
- LWRK_CUNMLQ = CDUMMY(1) \r
- IF ( ERREST ) THEN \r
- OPTWRK = MAX( N+LWRK_CGEQP3, LWCON, LWRK_CGESVJ, \r
- $ N+LWRK_CGELQF, 2*N+LWRK_CGEQRF,\r
- $ N+LWRK_CGESVJ, N+LWRK_CUNMLQ )\r
- ELSE\r
- OPTWRK = MAX( N+LWRK_CGEQP3, LWRK_CGESVJ,N+LWRK_CGELQF,\r
- $ 2*N+LWRK_CGEQRF, N+LWRK_CGESVJ, \r
- $ N+LWRK_CUNMLQ )\r
- END IF\r
- END IF\r
- IF ( L2TRAN .OR. ROWPIV ) THEN \r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ ) \r
- END IF \r
- ELSE\r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ ) \r
- END IF \r
- END IF\r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M\r
- ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN \r
-* .. minimal and optimal sizes of the complex workspace if the\r
-* singular values and the left singular vectors are requested\r
- IF ( ERREST ) THEN\r
- MINWRK = N + MAX( LWQP3,LWCON,N+LWQRF,LWSVDJ,LWUNMQRM )\r
- ELSE\r
- MINWRK = N + MAX( LWQP3, N+LWQRF, LWSVDJ, LWUNMQRM )\r
- END IF\r
- IF ( LQUERY ) THEN\r
- CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,\r
- $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_CGESVJ = CDUMMY(1)\r
- CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,\r
- $ LDU, CDUMMY, -1, IERR )\r
- LWRK_CUNMQRM = CDUMMY(1)\r
- IF ( ERREST ) THEN\r
- OPTWRK = N + MAX( LWRK_CGEQP3, LWCON, N+LWRK_CGEQRF,\r
- $ LWRK_CGESVJ, LWRK_CUNMQRM )\r
- ELSE\r
- OPTWRK = N + MAX( LWRK_CGEQP3, N+LWRK_CGEQRF,\r
- $ LWRK_CGESVJ, LWRK_CUNMQRM )\r
- END IF\r
- END IF\r
- IF ( L2TRAN .OR. ROWPIV ) THEN \r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )\r
- END IF \r
- ELSE\r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )\r
- END IF \r
- END IF \r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M\r
- ELSE\r
-* .. minimal and optimal sizes of the complex workspace if the\r
-* full SVD is requested\r
- IF ( .NOT. JRACC ) THEN \r
- IF ( ERREST ) THEN \r
- MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+N**2+LWCON, \r
- $ 2*N+LWQRF, 2*N+LWQP3, \r
- $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON,\r
- $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV, \r
- $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ, \r
- $ N+N**2+LWSVDJ, N+LWUNMQRM )\r
- ELSE\r
- MINWRK = MAX( N+LWQP3, 2*N+N**2+LWCON, \r
- $ 2*N+LWQRF, 2*N+LWQP3, \r
- $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON,\r
- $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV,\r
- $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ,\r
- $ N+N**2+LWSVDJ, N+LWUNMQRM ) \r
- END IF \r
- MINIWRK = MINIWRK + N \r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M\r
- ELSE\r
- IF ( ERREST ) THEN \r
- MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+LWQRF, \r
- $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR, \r
- $ N+LWUNMQRM )\r
- ELSE\r
- MINWRK = MAX( N+LWQP3, 2*N+LWQRF, \r
- $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR, \r
- $ N+LWUNMQRM ) \r
- END IF \r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M\r
- END IF\r
- IF ( LQUERY ) THEN\r
- CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,\r
- $ LDU, CDUMMY, -1, IERR )\r
- LWRK_CUNMQRM = CDUMMY(1)\r
- CALL CUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U,\r
- $ LDU, CDUMMY, -1, IERR )\r
- LWRK_CUNMQR = CDUMMY(1)\r
- IF ( .NOT. JRACC ) THEN\r
- CALL CGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1,\r
- $ RDUMMY, IERR )\r
- LWRK_CGEQP3N = CDUMMY(1)\r
- CALL CGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA,\r
- $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_CGESVJ = CDUMMY(1)\r
- CALL CGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA,\r
- $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_CGESVJU = CDUMMY(1)\r
- CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,\r
- $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_CGESVJV = CDUMMY(1)\r
- CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,\r
- $ V, LDV, CDUMMY, -1, IERR )\r
- LWRK_CUNMLQ = CDUMMY(1)\r
- IF ( ERREST ) THEN \r
- OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON, \r
- $ 2*N+N**2+LWCON, 2*N+LWRK_CGEQRF, \r
- $ 2*N+LWRK_CGEQP3N, \r
- $ 2*N+N**2+N+LWRK_CGELQF, \r
- $ 2*N+N**2+N+N**2+LWCON,\r
- $ 2*N+N**2+N+LWRK_CGESVJ, \r
- $ 2*N+N**2+N+LWRK_CGESVJV, \r
- $ 2*N+N**2+N+LWRK_CUNMQR,\r
- $ 2*N+N**2+N+LWRK_CUNMLQ, \r
- $ N+N**2+LWRK_CGESVJU, \r
- $ N+LWRK_CUNMQRM )\r
- ELSE\r
- OPTWRK = MAX( N+LWRK_CGEQP3, \r
- $ 2*N+N**2+LWCON, 2*N+LWRK_CGEQRF, \r
- $ 2*N+LWRK_CGEQP3N, \r
- $ 2*N+N**2+N+LWRK_CGELQF, \r
- $ 2*N+N**2+N+N**2+LWCON,\r
- $ 2*N+N**2+N+LWRK_CGESVJ, \r
- $ 2*N+N**2+N+LWRK_CGESVJV, \r
- $ 2*N+N**2+N+LWRK_CUNMQR,\r
- $ 2*N+N**2+N+LWRK_CUNMLQ, \r
- $ N+N**2+LWRK_CGESVJU,\r
- $ N+LWRK_CUNMQRM )\r
- END IF \r
- ELSE\r
- CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,\r
- $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_CGESVJV = CDUMMY(1)\r
- CALL CUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY,\r
- $ V, LDV, CDUMMY, -1, IERR )\r
- LWRK_CUNMQR = CDUMMY(1)\r
- CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,\r
- $ LDU, CDUMMY, -1, IERR )\r
- LWRK_CUNMQRM = CDUMMY(1) \r
- IF ( ERREST ) THEN \r
- OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON, \r
- $ 2*N+LWRK_CGEQRF, 2*N+N**2, \r
- $ 2*N+N**2+LWRK_CGESVJV, \r
- $ 2*N+N**2+N+LWRK_CUNMQR,N+LWRK_CUNMQRM )\r
- ELSE\r
- OPTWRK = MAX( N+LWRK_CGEQP3, 2*N+LWRK_CGEQRF, \r
- $ 2*N+N**2, 2*N+N**2+LWRK_CGESVJV, \r
- $ 2*N+N**2+N+LWRK_CUNMQR, \r
- $ N+LWRK_CUNMQRM ) \r
- END IF \r
- END IF \r
- END IF \r
- IF ( L2TRAN .OR. ROWPIV ) THEN \r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )\r
- END IF \r
- END IF\r
- MINWRK = MAX( 2, MINWRK )\r
- OPTWRK = MAX( 2, OPTWRK )\r
- IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = - 17\r
- IF ( LRWORK .LT. MINRWRK .AND. (.NOT.LQUERY) ) INFO = - 19 \r
- END IF\r
-* \r
- IF ( INFO .NE. 0 ) THEN\r
-* #:(\r
- CALL XERBLA( 'CGEJSV', - INFO )\r
- RETURN\r
- ELSE IF ( LQUERY ) THEN\r
- CWORK(1) = OPTWRK\r
- CWORK(2) = MINWRK\r
- RWORK(1) = MINRWRK\r
- IWORK(1) = MAX( 4, MINIWRK )\r
- RETURN \r
- END IF\r
-*\r
-* Quick return for void matrix (Y3K safe)\r
-* #:)\r
- IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN\r
- IWORK(1:4) = 0\r
- RWORK(1:7) = 0\r
- RETURN\r
- ENDIF\r
-*\r
-* Determine whether the matrix U should be M x N or M x M\r
-*\r
- IF ( LSVEC ) THEN\r
- N1 = N\r
- IF ( LSAME( JOBU, 'F' ) ) N1 = M\r
- END IF\r
-*\r
-* Set numerical parameters\r
-*\r
-*! NOTE: Make sure SLAMCH() does not fail on the target architecture.\r
-*\r
- EPSLN = SLAMCH('Epsilon')\r
- SFMIN = SLAMCH('SafeMinimum')\r
- SMALL = SFMIN / EPSLN\r
- BIG = SLAMCH('O')\r
-* BIG = ONE / SFMIN\r
-*\r
-* Initialize SVA(1:N) = diag( ||A e_i||_2 )_1^N\r
-*\r
-*(!) If necessary, scale SVA() to protect the largest norm from\r
-* overflow. It is possible that this scaling pushes the smallest\r
-* column norm left from the underflow threshold (extreme case).\r
-*\r
- SCALEM = ONE / SQRT(REAL(M)*REAL(N))\r
- NOSCAL = .TRUE.\r
- GOSCAL = .TRUE.\r
- DO 1874 p = 1, N\r
- AAPP = ZERO\r
- AAQQ = ONE\r
- CALL CLASSQ( M, A(1,p), 1, AAPP, AAQQ )\r
- IF ( AAPP .GT. BIG ) THEN\r
- INFO = - 9\r
- CALL XERBLA( 'CGEJSV', -INFO )\r
- RETURN\r
- END IF\r
- AAQQ = SQRT(AAQQ)\r
- IF ( ( AAPP .LT. (BIG / AAQQ) ) .AND. NOSCAL ) THEN\r
- SVA(p) = AAPP * AAQQ\r
- ELSE\r
- NOSCAL = .FALSE.\r
- SVA(p) = AAPP * ( AAQQ * SCALEM )\r
- IF ( GOSCAL ) THEN\r
- GOSCAL = .FALSE.\r
- CALL SSCAL( p-1, SCALEM, SVA, 1 )\r
- END IF\r
- END IF\r
- 1874 CONTINUE\r
-*\r
- IF ( NOSCAL ) SCALEM = ONE\r
-*\r
- AAPP = ZERO\r
- AAQQ = BIG\r
- DO 4781 p = 1, N\r
- AAPP = MAX( AAPP, SVA(p) )\r
- IF ( SVA(p) .NE. ZERO ) AAQQ = MIN( AAQQ, SVA(p) )\r
- 4781 CONTINUE\r
-*\r
-* Quick return for zero M x N matrix\r
-* #:)\r
- IF ( AAPP .EQ. ZERO ) THEN\r
- IF ( LSVEC ) CALL CLASET( 'G', M, N1, CZERO, CONE, U, LDU )\r
- IF ( RSVEC ) CALL CLASET( 'G', N, N, CZERO, CONE, V, LDV )\r
- RWORK(1) = ONE\r
- RWORK(2) = ONE\r
- IF ( ERREST ) RWORK(3) = ONE\r
- IF ( LSVEC .AND. RSVEC ) THEN\r
- RWORK(4) = ONE\r
- RWORK(5) = ONE\r
- END IF\r
- IF ( L2TRAN ) THEN\r
- RWORK(6) = ZERO\r
- RWORK(7) = ZERO\r
- END IF\r
- IWORK(1) = 0\r
- IWORK(2) = 0\r
- IWORK(3) = 0\r
- IWORK(4) = -1\r
- RETURN\r
- END IF\r
-*\r
-* Issue warning if denormalized column norms detected. Override the\r
-* high relative accuracy request. Issue licence to kill nonzero columns\r
-* (set them to zero) whose norm is less than sigma_max / BIG (roughly).\r
-* #:(\r
- WARNING = 0\r
- IF ( AAQQ .LE. SFMIN ) THEN\r
- L2RANK = .TRUE.\r
- L2KILL = .TRUE.\r
- WARNING = 1\r
- END IF\r
-*\r
-* Quick return for one-column matrix\r
-* #:)\r
- IF ( N .EQ. 1 ) THEN\r
-*\r
- IF ( LSVEC ) THEN\r
- CALL CLASCL( 'G',0,0,SVA(1),SCALEM, M,1,A(1,1),LDA,IERR )\r
- CALL CLACPY( 'A', M, 1, A, LDA, U, LDU )\r
-* computing all M left singular vectors of the M x 1 matrix\r
- IF ( N1 .NE. N ) THEN\r
- CALL CGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N,IERR )\r
- CALL CUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N,IERR )\r
- CALL CCOPY( M, A(1,1), 1, U(1,1), 1 )\r
- END IF\r
- END IF\r
- IF ( RSVEC ) THEN\r
- V(1,1) = CONE\r
- END IF\r
- IF ( SVA(1) .LT. (BIG*SCALEM) ) THEN\r
- SVA(1) = SVA(1) / SCALEM\r
- SCALEM = ONE\r
- END IF\r
- RWORK(1) = ONE / SCALEM\r
- RWORK(2) = ONE\r
- IF ( SVA(1) .NE. ZERO ) THEN\r
- IWORK(1) = 1\r
- IF ( ( SVA(1) / SCALEM) .GE. SFMIN ) THEN\r
- IWORK(2) = 1\r
- ELSE\r
- IWORK(2) = 0\r
- END IF\r
- ELSE\r
- IWORK(1) = 0\r
- IWORK(2) = 0\r
- END IF\r
- IWORK(3) = 0\r
- IWORK(4) = -1\r
- IF ( ERREST ) RWORK(3) = ONE\r
- IF ( LSVEC .AND. RSVEC ) THEN\r
- RWORK(4) = ONE\r
- RWORK(5) = ONE\r
- END IF\r
- IF ( L2TRAN ) THEN\r
- RWORK(6) = ZERO\r
- RWORK(7) = ZERO\r
- END IF\r
- RETURN\r
-*\r
- END IF\r
-*\r
- TRANSP = .FALSE.\r
-*\r
- AATMAX = -ONE\r
- AATMIN = BIG\r
- IF ( ROWPIV .OR. L2TRAN ) THEN\r
-*\r
-* Compute the row norms, needed to determine row pivoting sequence\r
-* (in the case of heavily row weighted A, row pivoting is strongly\r
-* advised) and to collect information needed to compare the\r
-* structures of A * A^* and A^* * A (in the case L2TRAN.EQ..TRUE.).\r
-*\r
- IF ( L2TRAN ) THEN\r
- DO 1950 p = 1, M\r
- XSC = ZERO\r
- TEMP1 = ONE\r
- CALL CLASSQ( N, A(p,1), LDA, XSC, TEMP1 )\r
-* CLASSQ gets both the ell_2 and the ell_infinity norm\r
-* in one pass through the vector\r
- RWORK(M+p) = XSC * SCALEM\r
- RWORK(p) = XSC * (SCALEM*SQRT(TEMP1))\r
- AATMAX = MAX( AATMAX, RWORK(p) )\r
- IF (RWORK(p) .NE. ZERO) \r
- $ AATMIN = MIN(AATMIN,RWORK(p))\r
- 1950 CONTINUE\r
- ELSE\r
- DO 1904 p = 1, M\r
- RWORK(M+p) = SCALEM*ABS( A(p,ICAMAX(N,A(p,1),LDA)) )\r
- AATMAX = MAX( AATMAX, RWORK(M+p) )\r
- AATMIN = MIN( AATMIN, RWORK(M+p) )\r
- 1904 CONTINUE\r
- END IF\r
-*\r
- END IF\r
-*\r
-* For square matrix A try to determine whether A^* would be better\r
-* input for the preconditioned Jacobi SVD, with faster convergence.\r
-* The decision is based on an O(N) function of the vector of column\r
-* and row norms of A, based on the Shannon entropy. This should give\r
-* the right choice in most cases when the difference actually matters.\r
-* It may fail and pick the slower converging side.\r
-*\r
- ENTRA = ZERO\r
- ENTRAT = ZERO\r
- IF ( L2TRAN ) THEN\r
-*\r
- XSC = ZERO\r
- TEMP1 = ONE\r
- CALL SLASSQ( N, SVA, 1, XSC, TEMP1 )\r
- TEMP1 = ONE / TEMP1\r
-*\r
- ENTRA = ZERO\r
- DO 1113 p = 1, N\r
- BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1\r
- IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * ALOG(BIG1)\r
- 1113 CONTINUE\r
- ENTRA = - ENTRA / ALOG(REAL(N))\r
-*\r
-* Now, SVA().^2/Trace(A^* * A) is a point in the probability simplex.\r
-* It is derived from the diagonal of A^* * A. Do the same with the\r
-* diagonal of A * A^*, compute the entropy of the corresponding\r
-* probability distribution. Note that A * A^* and A^* * A have the\r
-* same trace.\r
-*\r
- ENTRAT = ZERO\r
- DO 1114 p = 1, M\r
- BIG1 = ( ( RWORK(p) / XSC )**2 ) * TEMP1\r
- IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * ALOG(BIG1)\r
- 1114 CONTINUE\r
- ENTRAT = - ENTRAT / ALOG(REAL(M))\r
-*\r
-* Analyze the entropies and decide A or A^*. Smaller entropy\r
-* usually means better input for the algorithm.\r
-*\r
- TRANSP = ( ENTRAT .LT. ENTRA )\r
-* \r
-* If A^* is better than A, take the adjoint of A. This is allowed\r
-* only for square matrices, M=N. \r
- IF ( TRANSP ) THEN\r
-* In an optimal implementation, this trivial transpose\r
-* should be replaced with faster transpose.\r
- DO 1115 p = 1, N - 1\r
- A(p,p) = CONJG(A(p,p))\r
- DO 1116 q = p + 1, N\r
- CTEMP = CONJG(A(q,p))\r
- A(q,p) = CONJG(A(p,q))\r
- A(p,q) = CTEMP\r
- 1116 CONTINUE\r
- 1115 CONTINUE\r
- A(N,N) = CONJG(A(N,N))\r
- DO 1117 p = 1, N\r
- RWORK(M+p) = SVA(p)\r
- SVA(p) = RWORK(p)\r
-* previously computed row 2-norms are now column 2-norms\r
-* of the transposed matrix\r
- 1117 CONTINUE\r
- TEMP1 = AAPP\r
- AAPP = AATMAX\r
- AATMAX = TEMP1\r
- TEMP1 = AAQQ\r
- AAQQ = AATMIN\r
- AATMIN = TEMP1\r
- KILL = LSVEC\r
- LSVEC = RSVEC\r
- RSVEC = KILL\r
- IF ( LSVEC ) N1 = N\r
-*\r
- ROWPIV = .TRUE.\r
- END IF\r
-*\r
- END IF\r
-* END IF L2TRAN\r
-*\r
-* Scale the matrix so that its maximal singular value remains less\r
-* than SQRT(BIG) -- the matrix is scaled so that its maximal column\r
-* has Euclidean norm equal to SQRT(BIG/N). The only reason to keep\r
-* SQRT(BIG) instead of BIG is the fact that CGEJSV uses LAPACK and\r
-* BLAS routines that, in some implementations, are not capable of\r
-* working in the full interval [SFMIN,BIG] and that they may provoke\r
-* overflows in the intermediate results. If the singular values spread\r
-* from SFMIN to BIG, then CGESVJ will compute them. So, in that case,\r
-* one should use CGESVJ instead of CGEJSV.\r
- BIG1 = SQRT( BIG )\r
- TEMP1 = SQRT( BIG / REAL(N) )\r
-* >> for future updates: allow bigger range, i.e. the largest column\r
-* will be allowed up to BIG/N and CGESVJ will do the rest. However, for\r
-* this all other (LAPACK) components must allow such a range. \r
-* TEMP1 = BIG/REAL(N)\r
-* TEMP1 = BIG * EPSLN this should 'almost' work with current LAPACK components\r
- CALL SLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR )\r
- IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN\r
- AAQQ = ( AAQQ / AAPP ) * TEMP1\r
- ELSE\r
- AAQQ = ( AAQQ * TEMP1 ) / AAPP\r
- END IF\r
- TEMP1 = TEMP1 * SCALEM\r
- CALL CLASCL( 'G', 0, 0, AAPP, TEMP1, M, N, A, LDA, IERR )\r
-*\r
-* To undo scaling at the end of this procedure, multiply the\r
-* computed singular values with USCAL2 / USCAL1.\r
-*\r
- USCAL1 = TEMP1\r
- USCAL2 = AAPP\r
-*\r
- IF ( L2KILL ) THEN\r
-* L2KILL enforces computation of nonzero singular values in\r
-* the restricted range of condition number of the initial A,\r
-* sigma_max(A) / sigma_min(A) approx. SQRT(BIG)/SQRT(SFMIN).\r
- XSC = SQRT( SFMIN )\r
- ELSE\r
- XSC = SMALL\r
-*\r
-* Now, if the condition number of A is too big,\r
-* sigma_max(A) / sigma_min(A) .GT. SQRT(BIG/N) * EPSLN / SFMIN,\r
-* as a precaution measure, the full SVD is computed using CGESVJ\r
-* with accumulated Jacobi rotations. This provides numerically\r
-* more robust computation, at the cost of slightly increased run\r
-* time. Depending on the concrete implementation of BLAS and LAPACK\r
-* (i.e. how they behave in presence of extreme ill-conditioning) the\r
-* implementor may decide to remove this switch.\r
- IF ( ( AAQQ.LT.SQRT(SFMIN) ) .AND. LSVEC .AND. RSVEC ) THEN\r
- JRACC = .TRUE.\r
- END IF\r
-*\r
- END IF\r
- IF ( AAQQ .LT. XSC ) THEN\r
- DO 700 p = 1, N\r
- IF ( SVA(p) .LT. XSC ) THEN\r
- CALL CLASET( 'A', M, 1, CZERO, CZERO, A(1,p), LDA )\r
- SVA(p) = ZERO\r
- END IF\r
- 700 CONTINUE\r
- END IF\r
-*\r
-* Preconditioning using QR factorization with pivoting\r
-*\r
- IF ( ROWPIV ) THEN\r
-* Optional row permutation (Bjoerck row pivoting):\r
-* A result by Cox and Higham shows that the Bjoerck's\r
-* row pivoting combined with standard column pivoting\r
-* has similar effect as Powell-Reid complete pivoting.\r
-* The ell-infinity norms of A are made nonincreasing.\r
- IF ( ( LSVEC .AND. RSVEC ) .AND. .NOT.( JRACC ) ) THEN \r
- IWOFF = 2*N\r
- ELSE\r
- IWOFF = N\r
- END IF\r
- DO 1952 p = 1, M - 1\r
- q = ISAMAX( M-p+1, RWORK(M+p), 1 ) + p - 1\r
- IWORK(IWOFF+p) = q\r
- IF ( p .NE. q ) THEN\r
- TEMP1 = RWORK(M+p)\r
- RWORK(M+p) = RWORK(M+q)\r
- RWORK(M+q) = TEMP1\r
- END IF\r
- 1952 CONTINUE\r
- CALL CLASWP( N, A, LDA, 1, M-1, IWORK(IWOFF+1), 1 )\r
- END IF\r
-*\r
-* End of the preparation phase (scaling, optional sorting and\r
-* transposing, optional flushing of small columns).\r
-*\r
-* Preconditioning\r
-*\r
-* If the full SVD is needed, the right singular vectors are computed\r
-* from a matrix equation, and for that we need theoretical analysis\r
-* of the Businger-Golub pivoting. So we use CGEQP3 as the first RR QRF.\r
-* In all other cases the first RR QRF can be chosen by other criteria\r
-* (eg speed by replacing global with restricted window pivoting, such\r
-* as in xGEQPX from TOMS # 782). Good results will be obtained using\r
-* xGEQPX with properly (!) chosen numerical parameters.\r
-* Any improvement of CGEQP3 improves overal performance of CGEJSV.\r
-*\r
-* A * P1 = Q1 * [ R1^* 0]^*:\r
- DO 1963 p = 1, N\r
-* .. all columns are free columns\r
- IWORK(p) = 0\r
- 1963 CONTINUE\r
- CALL CGEQP3( M, N, A, LDA, IWORK, CWORK, CWORK(N+1), LWORK-N,\r
- $ RWORK, IERR )\r
-*\r
-* The upper triangular matrix R1 from the first QRF is inspected for\r
-* rank deficiency and possibilities for deflation, or possible\r
-* ill-conditioning. Depending on the user specified flag L2RANK,\r
-* the procedure explores possibilities to reduce the numerical\r
-* rank by inspecting the computed upper triangular factor. If\r
-* L2RANK or L2ABER are up, then CGEJSV will compute the SVD of\r
-* A + dA, where ||dA|| <= f(M,N)*EPSLN.\r
-*\r
- NR = 1\r
- IF ( L2ABER ) THEN\r
-* Standard absolute error bound suffices. All sigma_i with\r
-* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an\r
-* agressive enforcement of lower numerical rank by introducing a\r
-* backward error of the order of N*EPSLN*||A||.\r
- TEMP1 = SQRT(REAL(N))*EPSLN\r
- DO 3001 p = 2, N\r
- IF ( ABS(A(p,p)) .GE. (TEMP1*ABS(A(1,1))) ) THEN\r
- NR = NR + 1\r
- ELSE\r
- GO TO 3002\r
- END IF\r
- 3001 CONTINUE\r
- 3002 CONTINUE\r
- ELSE IF ( L2RANK ) THEN\r
-* .. similarly as above, only slightly more gentle (less agressive).\r
-* Sudden drop on the diagonal of R1 is used as the criterion for\r
-* close-to-rank-defficient.\r
- TEMP1 = SQRT(SFMIN)\r
- DO 3401 p = 2, N\r
- IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR.\r
- $ ( ABS(A(p,p)) .LT. SMALL ) .OR.\r
- $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3402\r
- NR = NR + 1\r
- 3401 CONTINUE\r
- 3402 CONTINUE\r
-*\r
- ELSE\r
-* The goal is high relative accuracy. However, if the matrix\r
-* has high scaled condition number the relative accuracy is in\r
-* general not feasible. Later on, a condition number estimator\r
-* will be deployed to estimate the scaled condition number.\r
-* Here we just remove the underflowed part of the triangular\r
-* factor. This prevents the situation in which the code is\r
-* working hard to get the accuracy not warranted by the data.\r
- TEMP1 = SQRT(SFMIN)\r
- DO 3301 p = 2, N\r
- IF ( ( ABS(A(p,p)) .LT. SMALL ) .OR.\r
- $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3302\r
- NR = NR + 1\r
- 3301 CONTINUE\r
- 3302 CONTINUE\r
-*\r
- END IF\r
-*\r
- ALMORT = .FALSE.\r
- IF ( NR .EQ. N ) THEN\r
- MAXPRJ = ONE\r
- DO 3051 p = 2, N\r
- TEMP1 = ABS(A(p,p)) / SVA(IWORK(p))\r
- MAXPRJ = MIN( MAXPRJ, TEMP1 )\r
- 3051 CONTINUE\r
- IF ( MAXPRJ**2 .GE. ONE - REAL(N)*EPSLN ) ALMORT = .TRUE.\r
- END IF\r
-*\r
-*\r
- SCONDA = - ONE\r
- CONDR1 = - ONE\r
- CONDR2 = - ONE\r
-*\r
- IF ( ERREST ) THEN\r
- IF ( N .EQ. NR ) THEN\r
- IF ( RSVEC ) THEN\r
-* .. V is available as workspace\r
- CALL CLACPY( 'U', N, N, A, LDA, V, LDV )\r
- DO 3053 p = 1, N\r
- TEMP1 = SVA(IWORK(p))\r
- CALL CSSCAL( p, ONE/TEMP1, V(1,p), 1 )\r
- 3053 CONTINUE\r
- IF ( LSVEC )THEN\r
- CALL CPOCON( 'U', N, V, LDV, ONE, TEMP1,\r
- $ CWORK(N+1), RWORK, IERR )\r
- ELSE\r
- CALL CPOCON( 'U', N, V, LDV, ONE, TEMP1,\r
- $ CWORK, RWORK, IERR )\r
- END IF \r
-* \r
- ELSE IF ( LSVEC ) THEN\r
-* .. U is available as workspace\r
- CALL CLACPY( 'U', N, N, A, LDA, U, LDU )\r
- DO 3054 p = 1, N\r
- TEMP1 = SVA(IWORK(p))\r
- CALL CSSCAL( p, ONE/TEMP1, U(1,p), 1 )\r
- 3054 CONTINUE\r
- CALL CPOCON( 'U', N, U, LDU, ONE, TEMP1,\r
- $ CWORK(N+1), RWORK, IERR )\r
- ELSE\r
- CALL CLACPY( 'U', N, N, A, LDA, CWORK, N )\r
-*[] CALL CLACPY( 'U', N, N, A, LDA, CWORK(N+1), N )\r
-* Change: here index shifted by N to the left, CWORK(1:N) \r
-* not needed for SIGMA only computation\r
- DO 3052 p = 1, N\r
- TEMP1 = SVA(IWORK(p))\r
-*[] CALL CSSCAL( p, ONE/TEMP1, CWORK(N+(p-1)*N+1), 1 )\r
- CALL CSSCAL( p, ONE/TEMP1, CWORK((p-1)*N+1), 1 )\r
- 3052 CONTINUE\r
-* .. the columns of R are scaled to have unit Euclidean lengths.\r
-*[] CALL CPOCON( 'U', N, CWORK(N+1), N, ONE, TEMP1,\r
-*[] $ CWORK(N+N*N+1), RWORK, IERR )\r
- CALL CPOCON( 'U', N, CWORK, N, ONE, TEMP1,\r
- $ CWORK(N*N+1), RWORK, IERR ) \r
-* \r
- END IF\r
- IF ( TEMP1 .NE. ZERO ) THEN \r
- SCONDA = ONE / SQRT(TEMP1)\r
- ELSE\r
- SCONDA = - ONE\r
- END IF\r
-* SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1).\r
-* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA\r
- ELSE\r
- SCONDA = - ONE\r
- END IF\r
- END IF\r
-*\r
- L2PERT = L2PERT .AND. ( ABS( A(1,1)/A(NR,NR) ) .GT. SQRT(BIG1) )\r
-* If there is no violent scaling, artificial perturbation is not needed.\r
-*\r
-* Phase 3:\r
-*\r
- IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN\r
-*\r
-* Singular Values only\r
-*\r
-* .. transpose A(1:NR,1:N)\r
- DO 1946 p = 1, MIN( N-1, NR )\r
- CALL CCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 )\r
- CALL CLACGV( N-p+1, A(p,p), 1 )\r
- 1946 CONTINUE\r
- IF ( NR .EQ. N ) A(N,N) = CONJG(A(N,N))\r
-*\r
-* The following two DO-loops introduce small relative perturbation\r
-* into the strict upper triangle of the lower triangular matrix.\r
-* Small entries below the main diagonal are also changed.\r
-* This modification is useful if the computing environment does not\r
-* provide/allow FLUSH TO ZERO underflow, for it prevents many\r
-* annoying denormalized numbers in case of strongly scaled matrices.\r
-* The perturbation is structured so that it does not introduce any\r
-* new perturbation of the singular values, and it does not destroy\r
-* the job done by the preconditioner.\r
-* The licence for this perturbation is in the variable L2PERT, which\r
-* should be .FALSE. if FLUSH TO ZERO underflow is active.\r
-*\r
- IF ( .NOT. ALMORT ) THEN\r
-*\r
- IF ( L2PERT ) THEN\r
-* XSC = SQRT(SMALL)\r
- XSC = EPSLN / REAL(N)\r
- DO 4947 q = 1, NR\r
- CTEMP = CMPLX(XSC*ABS(A(q,q)),ZERO)\r
- DO 4949 p = 1, N\r
- IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )\r
- $ .OR. ( p .LT. q ) )\r
-* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) )\r
- $ A(p,q) = CTEMP\r
- 4949 CONTINUE\r
- 4947 CONTINUE\r
- ELSE\r
- CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, A(1,2),LDA )\r
- END IF\r
-*\r
-* .. second preconditioning using the QR factorization\r
-*\r
- CALL CGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, IERR )\r
-*\r
-* .. and transpose upper to lower triangular\r
- DO 1948 p = 1, NR - 1\r
- CALL CCOPY( NR-p, A(p,p+1), LDA, A(p+1,p), 1 )\r
- CALL CLACGV( NR-p+1, A(p,p), 1 )\r
- 1948 CONTINUE\r
-*\r
- END IF\r
-*\r
-* Row-cyclic Jacobi SVD algorithm with column pivoting\r
-*\r
-* .. again some perturbation (a "background noise") is added\r
-* to drown denormals\r
- IF ( L2PERT ) THEN\r
-* XSC = SQRT(SMALL)\r
- XSC = EPSLN / REAL(N)\r
- DO 1947 q = 1, NR\r
- CTEMP = CMPLX(XSC*ABS(A(q,q)),ZERO)\r
- DO 1949 p = 1, NR\r
- IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )\r
- $ .OR. ( p .LT. q ) )\r
-* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) )\r
- $ A(p,q) = CTEMP\r
- 1949 CONTINUE\r
- 1947 CONTINUE\r
- ELSE\r
- CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), LDA )\r
- END IF\r
-*\r
-* .. and one-sided Jacobi rotations are started on a lower\r
-* triangular matrix (plus perturbation which is ignored in\r
-* the part which destroys triangular form (confusing?!))\r
-*\r
- CALL CGESVJ( 'L', 'N', 'N', NR, NR, A, LDA, SVA,\r
- $ N, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO )\r
-*\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
-*\r
-*\r
- ELSE IF ( ( RSVEC .AND. ( .NOT. LSVEC ) .AND. ( .NOT. JRACC ) ) \r
- $ .OR. \r
- $ ( JRACC .AND. ( .NOT. LSVEC ) .AND. ( NR .NE. N ) ) ) THEN\r
-*\r
-* -> Singular Values and Right Singular Vectors <-\r
-*\r
- IF ( ALMORT ) THEN\r
-*\r
-* .. in this case NR equals N\r
- DO 1998 p = 1, NR\r
- CALL CCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )\r
- CALL CLACGV( N-p+1, V(p,p), 1 )\r
- 1998 CONTINUE\r
- CALL CLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV )\r
-*\r
- CALL CGESVJ( 'L','U','N', N, NR, V, LDV, SVA, NR, A, LDA,\r
- $ CWORK, LWORK, RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
-\r
- ELSE\r
-*\r
-* .. two more QR factorizations ( one QRF is not enough, two require\r
-* accumulated product of Jacobi rotations, three are perfect )\r
-*\r
- CALL CLASET( 'L', NR-1,NR-1, CZERO, CZERO, A(2,1), LDA )\r
- CALL CGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, IERR)\r
- CALL CLACPY( 'L', NR, NR, A, LDA, V, LDV )\r
- CALL CLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV )\r
- CALL CGEQRF( NR, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),\r
- $ LWORK-2*N, IERR )\r
- DO 8998 p = 1, NR\r
- CALL CCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 )\r
- CALL CLACGV( NR-p+1, V(p,p), 1 )\r
- 8998 CONTINUE\r
- CALL CLASET('U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV)\r
-*\r
- CALL CGESVJ( 'L', 'U','N', NR, NR, V,LDV, SVA, NR, U,\r
- $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- IF ( NR .LT. N ) THEN\r
- CALL CLASET( 'A',N-NR, NR, CZERO,CZERO, V(NR+1,1), LDV )\r
- CALL CLASET( 'A',NR, N-NR, CZERO,CZERO, V(1,NR+1), LDV )\r
- CALL CLASET( 'A',N-NR,N-NR,CZERO,CONE, V(NR+1,NR+1),LDV )\r
- END IF\r
-*\r
- CALL CUNMLQ( 'L', 'C', N, N, NR, A, LDA, CWORK,\r
- $ V, LDV, CWORK(N+1), LWORK-N, IERR )\r
-*\r
- END IF\r
-* .. permute the rows of V\r
-* DO 8991 p = 1, N\r
-* CALL CCOPY( N, V(p,1), LDV, A(IWORK(p),1), LDA )\r
-* 8991 CONTINUE\r
-* CALL CLACPY( 'All', N, N, A, LDA, V, LDV )\r
- CALL CLAPMR( .FALSE., N, N, V, LDV, IWORK )\r
-*\r
- IF ( TRANSP ) THEN\r
- CALL CLACPY( 'A', N, N, V, LDV, U, LDU )\r
- END IF\r
-*\r
- ELSE IF ( JRACC .AND. (.NOT. LSVEC) .AND. ( NR.EQ. N ) ) THEN \r
-* \r
- CALL CLASET( 'L', N-1,N-1, CZERO, CZERO, A(2,1), LDA )\r
-*\r
- CALL CGESVJ( 'U','N','V', N, N, A, LDA, SVA, N, V, LDV,\r
- $ CWORK, LWORK, RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- CALL CLAPMR( .FALSE., N, N, V, LDV, IWORK )\r
-*\r
- ELSE IF ( LSVEC .AND. ( .NOT. RSVEC ) ) THEN\r
-*\r
-* .. Singular Values and Left Singular Vectors ..\r
-*\r
-* .. second preconditioning step to avoid need to accumulate\r
-* Jacobi rotations in the Jacobi iterations.\r
- DO 1965 p = 1, NR\r
- CALL CCOPY( N-p+1, A(p,p), LDA, U(p,p), 1 )\r
- CALL CLACGV( N-p+1, U(p,p), 1 )\r
- 1965 CONTINUE\r
- CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )\r
-*\r
- CALL CGEQRF( N, NR, U, LDU, CWORK(N+1), CWORK(2*N+1),\r
- $ LWORK-2*N, IERR )\r
-*\r
- DO 1967 p = 1, NR - 1\r
- CALL CCOPY( NR-p, U(p,p+1), LDU, U(p+1,p), 1 )\r
- CALL CLACGV( N-p+1, U(p,p), 1 )\r
- 1967 CONTINUE\r
- CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )\r
-*\r
- CALL CGESVJ( 'L', 'U', 'N', NR,NR, U, LDU, SVA, NR, A,\r
- $ LDA, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
-*\r
- IF ( NR .LT. M ) THEN\r
- CALL CLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), LDU )\r
- IF ( NR .LT. N1 ) THEN\r
- CALL CLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU )\r
- CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1),LDU )\r
- END IF\r
- END IF\r
-*\r
- CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,\r
- $ LDU, CWORK(N+1), LWORK-N, IERR )\r
-*\r
- IF ( ROWPIV )\r
- $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )\r
-*\r
- DO 1974 p = 1, N1\r
- XSC = ONE / SCNRM2( M, U(1,p), 1 )\r
- CALL CSSCAL( M, XSC, U(1,p), 1 )\r
- 1974 CONTINUE\r
-*\r
- IF ( TRANSP ) THEN\r
- CALL CLACPY( 'A', N, N, U, LDU, V, LDV )\r
- END IF\r
-*\r
- ELSE\r
-*\r
-* .. Full SVD ..\r
-*\r
- IF ( .NOT. JRACC ) THEN\r
-*\r
- IF ( .NOT. ALMORT ) THEN\r
-*\r
-* Second Preconditioning Step (QRF [with pivoting])\r
-* Note that the composition of TRANSPOSE, QRF and TRANSPOSE is\r
-* equivalent to an LQF CALL. Since in many libraries the QRF\r
-* seems to be better optimized than the LQF, we do explicit\r
-* transpose and use the QRF. This is subject to changes in an\r
-* optimized implementation of CGEJSV.\r
-*\r
- DO 1968 p = 1, NR\r
- CALL CCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )\r
- CALL CLACGV( N-p+1, V(p,p), 1 )\r
- 1968 CONTINUE\r
-*\r
-* .. the following two loops perturb small entries to avoid\r
-* denormals in the second QR factorization, where they are\r
-* as good as zeros. This is done to avoid painfully slow\r
-* computation with denormals. The relative size of the perturbation\r
-* is a parameter that can be changed by the implementer.\r
-* This perturbation device will be obsolete on machines with\r
-* properly implemented arithmetic.\r
-* To switch it off, set L2PERT=.FALSE. To remove it from the\r
-* code, remove the action under L2PERT=.TRUE., leave the ELSE part.\r
-* The following two loops should be blocked and fused with the\r
-* transposed copy above.\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 2969 q = 1, NR\r
- CTEMP = CMPLX(XSC*ABS( V(q,q) ),ZERO)\r
- DO 2968 p = 1, N\r
- IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )\r
- $ .OR. ( p .LT. q ) )\r
-* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) )\r
- $ V(p,q) = CTEMP\r
- IF ( p .LT. q ) V(p,q) = - V(p,q)\r
- 2968 CONTINUE\r
- 2969 CONTINUE\r
- ELSE\r
- CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV )\r
- END IF\r
-*\r
-* Estimate the row scaled condition number of R1\r
-* (If R1 is rectangular, N > NR, then the condition number\r
-* of the leading NR x NR submatrix is estimated.)\r
-*\r
- CALL CLACPY( 'L', NR, NR, V, LDV, CWORK(2*N+1), NR )\r
- DO 3950 p = 1, NR\r
- TEMP1 = SCNRM2(NR-p+1,CWORK(2*N+(p-1)*NR+p),1)\r
- CALL CSSCAL(NR-p+1,ONE/TEMP1,CWORK(2*N+(p-1)*NR+p),1)\r
- 3950 CONTINUE\r
- CALL CPOCON('L',NR,CWORK(2*N+1),NR,ONE,TEMP1,\r
- $ CWORK(2*N+NR*NR+1),RWORK,IERR)\r
- CONDR1 = ONE / SQRT(TEMP1)\r
-* .. here need a second oppinion on the condition number\r
-* .. then assume worst case scenario\r
-* R1 is OK for inverse <=> CONDR1 .LT. REAL(N)\r
-* more conservative <=> CONDR1 .LT. SQRT(REAL(N))\r
-*\r
- COND_OK = SQRT(SQRT(REAL(NR)))\r
-*[TP] COND_OK is a tuning parameter.\r
-*\r
- IF ( CONDR1 .LT. COND_OK ) THEN\r
-* .. the second QRF without pivoting. Note: in an optimized\r
-* implementation, this QRF should be implemented as the QRF\r
-* of a lower triangular matrix.\r
-* R1^* = Q2 * R2\r
- CALL CGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),\r
- $ LWORK-2*N, IERR )\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)/EPSLN\r
- DO 3959 p = 2, NR\r
- DO 3958 q = 1, p - 1\r
- CTEMP=CMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),\r
- $ ZERO)\r
- IF ( ABS(V(q,p)) .LE. TEMP1 )\r
-* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) )\r
- $ V(q,p) = CTEMP\r
- 3958 CONTINUE\r
- 3959 CONTINUE\r
- END IF\r
-*\r
- IF ( NR .NE. N )\r
- $ CALL CLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N )\r
-* .. save ...\r
-*\r
-* .. this transposed copy should be better than naive\r
- DO 1969 p = 1, NR - 1\r
- CALL CCOPY( NR-p, V(p,p+1), LDV, V(p+1,p), 1 )\r
- CALL CLACGV(NR-p+1, V(p,p), 1 )\r
- 1969 CONTINUE\r
- V(NR,NR)=CONJG(V(NR,NR))\r
-*\r
- CONDR2 = CONDR1\r
-*\r
- ELSE\r
-*\r
-* .. ill-conditioned case: second QRF with pivoting\r
-* Note that windowed pivoting would be equaly good\r
-* numerically, and more run-time efficient. So, in\r
-* an optimal implementation, the next call to CGEQP3\r
-* should be replaced with eg. CALL CGEQPX (ACM TOMS #782)\r
-* with properly (carefully) chosen parameters.\r
-*\r
-* R1^* * P2 = Q2 * R2\r
- DO 3003 p = 1, NR\r
- IWORK(N+p) = 0\r
- 3003 CONTINUE\r
- CALL CGEQP3( N, NR, V, LDV, IWORK(N+1), CWORK(N+1),\r
- $ CWORK(2*N+1), LWORK-2*N, RWORK, IERR )\r
-** CALL CGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),\r
-** $ LWORK-2*N, IERR )\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 3969 p = 2, NR\r
- DO 3968 q = 1, p - 1\r
- CTEMP=CMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),\r
- $ ZERO)\r
- IF ( ABS(V(q,p)) .LE. TEMP1 )\r
-* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) )\r
- $ V(q,p) = CTEMP\r
- 3968 CONTINUE\r
- 3969 CONTINUE\r
- END IF\r
-*\r
- CALL CLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N )\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 8970 p = 2, NR\r
- DO 8971 q = 1, p - 1\r
- CTEMP=CMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),\r
- $ ZERO)\r
-* V(p,q) = - TEMP1*( V(q,p) / ABS(V(q,p)) )\r
- V(p,q) = - CTEMP\r
- 8971 CONTINUE\r
- 8970 CONTINUE\r
- ELSE\r
- CALL CLASET( 'L',NR-1,NR-1,CZERO,CZERO,V(2,1),LDV )\r
- END IF\r
-* Now, compute R2 = L3 * Q3, the LQ factorization.\r
- CALL CGELQF( NR, NR, V, LDV, CWORK(2*N+N*NR+1),\r
- $ CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, IERR )\r
-* .. and estimate the condition number\r
- CALL CLACPY( 'L',NR,NR,V,LDV,CWORK(2*N+N*NR+NR+1),NR )\r
- DO 4950 p = 1, NR\r
- TEMP1 = SCNRM2( p, CWORK(2*N+N*NR+NR+p), NR )\r
- CALL CSSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), NR )\r
- 4950 CONTINUE\r
- CALL CPOCON( 'L',NR,CWORK(2*N+N*NR+NR+1),NR,ONE,TEMP1,\r
- $ CWORK(2*N+N*NR+NR+NR*NR+1),RWORK,IERR )\r
- CONDR2 = ONE / SQRT(TEMP1)\r
-*\r
-*\r
- IF ( CONDR2 .GE. COND_OK ) THEN\r
-* .. save the Householder vectors used for Q3\r
-* (this overwrittes the copy of R2, as it will not be\r
-* needed in this branch, but it does not overwritte the\r
-* Huseholder vectors of Q2.).\r
- CALL CLACPY( 'U', NR, NR, V, LDV, CWORK(2*N+1), N )\r
-* .. and the rest of the information on Q3 is in\r
-* WORK(2*N+N*NR+1:2*N+N*NR+N)\r
- END IF\r
-*\r
- END IF\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 4968 q = 2, NR\r
- CTEMP = XSC * V(q,q)\r
- DO 4969 p = 1, q - 1\r
-* V(p,q) = - TEMP1*( V(p,q) / ABS(V(p,q)) )\r
- V(p,q) = - CTEMP\r
- 4969 CONTINUE\r
- 4968 CONTINUE\r
- ELSE\r
- CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV )\r
- END IF\r
-*\r
-* Second preconditioning finished; continue with Jacobi SVD\r
-* The input matrix is lower trinagular.\r
-*\r
-* Recover the right singular vectors as solution of a well\r
-* conditioned triangular matrix equation.\r
-*\r
- IF ( CONDR1 .LT. COND_OK ) THEN\r
-*\r
- CALL CGESVJ( 'L','U','N',NR,NR,V,LDV,SVA,NR,U, LDU,\r
- $ CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,RWORK,\r
- $ LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- DO 3970 p = 1, NR\r
- CALL CCOPY( NR, V(1,p), 1, U(1,p), 1 )\r
- CALL CSSCAL( NR, SVA(p), V(1,p), 1 )\r
- 3970 CONTINUE\r
-\r
-* .. pick the right matrix equation and solve it\r
-*\r
- IF ( NR .EQ. N ) THEN\r
-* :)) .. best case, R1 is inverted. The solution of this matrix\r
-* equation is Q2*V2 = the product of the Jacobi rotations\r
-* used in CGESVJ, premultiplied with the orthogonal matrix\r
-* from the second QR factorization.\r
- CALL CTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V,LDV)\r
- ELSE\r
-* .. R1 is well conditioned, but non-square. Adjoint of R2\r
-* is inverted to get the product of the Jacobi rotations\r
-* used in CGESVJ. The Q-factor from the second QR\r
-* factorization is then built in explicitly.\r
- CALL CTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1),\r
- $ N,V,LDV)\r
- IF ( NR .LT. N ) THEN\r
- CALL CLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV)\r
- CALL CLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV)\r
- CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)\r
- END IF\r
- CALL CUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),\r
- $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR)\r
- END IF\r
-*\r
- ELSE IF ( CONDR2 .LT. COND_OK ) THEN\r
-*\r
-* The matrix R2 is inverted. The solution of the matrix equation\r
-* is Q3^* * V3 = the product of the Jacobi rotations (appplied to\r
-* the lower triangular L3 from the LQ factorization of\r
-* R2=L3*Q3), pre-multiplied with the transposed Q3.\r
- CALL CGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U,\r
- $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR,\r
- $ RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- DO 3870 p = 1, NR\r
- CALL CCOPY( NR, V(1,p), 1, U(1,p), 1 )\r
- CALL CSSCAL( NR, SVA(p), U(1,p), 1 )\r
- 3870 CONTINUE\r
- CALL CTRSM('L','U','N','N',NR,NR,CONE,CWORK(2*N+1),N,\r
- $ U,LDU)\r
-* .. apply the permutation from the second QR factorization\r
- DO 873 q = 1, NR\r
- DO 872 p = 1, NR\r
- CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)\r
- 872 CONTINUE\r
- DO 874 p = 1, NR\r
- U(p,q) = CWORK(2*N+N*NR+NR+p)\r
- 874 CONTINUE\r
- 873 CONTINUE\r
- IF ( NR .LT. N ) THEN\r
- CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )\r
- CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )\r
- CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)\r
- END IF\r
- CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),\r
- $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )\r
- ELSE\r
-* Last line of defense.\r
-* #:( This is a rather pathological case: no scaled condition\r
-* improvement after two pivoted QR factorizations. Other\r
-* possibility is that the rank revealing QR factorization\r
-* or the condition estimator has failed, or the COND_OK\r
-* is set very close to ONE (which is unnecessary). Normally,\r
-* this branch should never be executed, but in rare cases of\r
-* failure of the RRQR or condition estimator, the last line of\r
-* defense ensures that CGEJSV completes the task.\r
-* Compute the full SVD of L3 using CGESVJ with explicit\r
-* accumulation of Jacobi rotations.\r
- CALL CGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U,\r
- $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR,\r
- $ RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- IF ( NR .LT. N ) THEN\r
- CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )\r
- CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )\r
- CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)\r
- END IF\r
- CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),\r
- $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )\r
-*\r
- CALL CUNMLQ( 'L', 'C', NR, NR, NR, CWORK(2*N+1), N,\r
- $ CWORK(2*N+N*NR+1), U, LDU, CWORK(2*N+N*NR+NR+1),\r
- $ LWORK-2*N-N*NR-NR, IERR )\r
- DO 773 q = 1, NR\r
- DO 772 p = 1, NR\r
- CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)\r
- 772 CONTINUE\r
- DO 774 p = 1, NR\r
- U(p,q) = CWORK(2*N+N*NR+NR+p)\r
- 774 CONTINUE\r
- 773 CONTINUE\r
-*\r
- END IF\r
-*\r
-* Permute the rows of V using the (column) permutation from the\r
-* first QRF. Also, scale the columns to make them unit in\r
-* Euclidean norm. This applies to all cases.\r
-*\r
- TEMP1 = SQRT(REAL(N)) * EPSLN\r
- DO 1972 q = 1, N\r
- DO 972 p = 1, N\r
- CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)\r
- 972 CONTINUE\r
- DO 973 p = 1, N\r
- V(p,q) = CWORK(2*N+N*NR+NR+p)\r
- 973 CONTINUE\r
- XSC = ONE / SCNRM2( N, V(1,q), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL CSSCAL( N, XSC, V(1,q), 1 )\r
- 1972 CONTINUE\r
-* At this moment, V contains the right singular vectors of A.\r
-* Next, assemble the left singular vector matrix U (M x N).\r
- IF ( NR .LT. M ) THEN\r
- CALL CLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU)\r
- IF ( NR .LT. N1 ) THEN\r
- CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU)\r
- CALL CLASET('A',M-NR,N1-NR,CZERO,CONE,\r
- $ U(NR+1,NR+1),LDU)\r
- END IF\r
- END IF\r
-*\r
-* The Q matrix from the first QRF is built into the left singular\r
-* matrix U. This applies to all cases.\r
-*\r
- CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,\r
- $ LDU, CWORK(N+1), LWORK-N, IERR )\r
-\r
-* The columns of U are normalized. The cost is O(M*N) flops.\r
- TEMP1 = SQRT(REAL(M)) * EPSLN\r
- DO 1973 p = 1, NR\r
- XSC = ONE / SCNRM2( M, U(1,p), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL CSSCAL( M, XSC, U(1,p), 1 )\r
- 1973 CONTINUE\r
-*\r
-* If the initial QRF is computed with row pivoting, the left\r
-* singular vectors must be adjusted.\r
-*\r
- IF ( ROWPIV )\r
- $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )\r
-*\r
- ELSE\r
-*\r
-* .. the initial matrix A has almost orthogonal columns and\r
-* the second QRF is not needed\r
-*\r
- CALL CLACPY( 'U', N, N, A, LDA, CWORK(N+1), N )\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 5970 p = 2, N\r
- CTEMP = XSC * CWORK( N + (p-1)*N + p )\r
- DO 5971 q = 1, p - 1\r
-* CWORK(N+(q-1)*N+p)=-TEMP1 * ( CWORK(N+(p-1)*N+q) /\r
-* $ ABS(CWORK(N+(p-1)*N+q)) )\r
- CWORK(N+(q-1)*N+p)=-CTEMP\r
- 5971 CONTINUE\r
- 5970 CONTINUE\r
- ELSE\r
- CALL CLASET( 'L',N-1,N-1,CZERO,CZERO,CWORK(N+2),N )\r
- END IF\r
-*\r
- CALL CGESVJ( 'U', 'U', 'N', N, N, CWORK(N+1), N, SVA,\r
- $ N, U, LDU, CWORK(N+N*N+1), LWORK-N-N*N, RWORK, LRWORK,\r
- $ INFO )\r
-*\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- DO 6970 p = 1, N\r
- CALL CCOPY( N, CWORK(N+(p-1)*N+1), 1, U(1,p), 1 )\r
- CALL CSSCAL( N, SVA(p), CWORK(N+(p-1)*N+1), 1 )\r
- 6970 CONTINUE\r
-*\r
- CALL CTRSM( 'L', 'U', 'N', 'N', N, N,\r
- $ CONE, A, LDA, CWORK(N+1), N )\r
- DO 6972 p = 1, N\r
- CALL CCOPY( N, CWORK(N+p), N, V(IWORK(p),1), LDV )\r
- 6972 CONTINUE\r
- TEMP1 = SQRT(REAL(N))*EPSLN\r
- DO 6971 p = 1, N\r
- XSC = ONE / SCNRM2( N, V(1,p), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL CSSCAL( N, XSC, V(1,p), 1 )\r
- 6971 CONTINUE\r
-*\r
-* Assemble the left singular vector matrix U (M x N).\r
-*\r
- IF ( N .LT. M ) THEN\r
- CALL CLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), LDU )\r
- IF ( N .LT. N1 ) THEN\r
- CALL CLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1),LDU)\r
- CALL CLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1),LDU)\r
- END IF\r
- END IF\r
- CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,\r
- $ LDU, CWORK(N+1), LWORK-N, IERR )\r
- TEMP1 = SQRT(REAL(M))*EPSLN\r
- DO 6973 p = 1, N1\r
- XSC = ONE / SCNRM2( M, U(1,p), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL CSSCAL( M, XSC, U(1,p), 1 )\r
- 6973 CONTINUE\r
-*\r
- IF ( ROWPIV )\r
- $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )\r
-*\r
- END IF\r
-*\r
-* end of the >> almost orthogonal case << in the full SVD\r
-*\r
- ELSE\r
-*\r
-* This branch deploys a preconditioned Jacobi SVD with explicitly\r
-* accumulated rotations. It is included as optional, mainly for\r
-* experimental purposes. It does perfom well, and can also be used.\r
-* In this implementation, this branch will be automatically activated\r
-* if the condition number sigma_max(A) / sigma_min(A) is predicted\r
-* to be greater than the overflow threshold. This is because the\r
-* a posteriori computation of the singular vectors assumes robust\r
-* implementation of BLAS and some LAPACK procedures, capable of working\r
-* in presence of extreme values, e.g. when the singular values spread from\r
-* the underflow to the overflow threshold. \r
-*\r
- DO 7968 p = 1, NR\r
- CALL CCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )\r
- CALL CLACGV( N-p+1, V(p,p), 1 )\r
- 7968 CONTINUE\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL/EPSLN)\r
- DO 5969 q = 1, NR\r
- CTEMP = CMPLX(XSC*ABS( V(q,q) ),ZERO)\r
- DO 5968 p = 1, N\r
- IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )\r
- $ .OR. ( p .LT. q ) )\r
-* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) )\r
- $ V(p,q) = CTEMP\r
- IF ( p .LT. q ) V(p,q) = - V(p,q)\r
- 5968 CONTINUE\r
- 5969 CONTINUE\r
- ELSE\r
- CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV )\r
- END IF\r
-\r
- CALL CGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),\r
- $ LWORK-2*N, IERR )\r
- CALL CLACPY( 'L', N, NR, V, LDV, CWORK(2*N+1), N )\r
-*\r
- DO 7969 p = 1, NR\r
- CALL CCOPY( NR-p+1, V(p,p), LDV, U(p,p), 1 )\r
- CALL CLACGV( NR-p+1, U(p,p), 1 )\r
- 7969 CONTINUE\r
-\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL/EPSLN)\r
- DO 9970 q = 2, NR\r
- DO 9971 p = 1, q - 1\r
- CTEMP = CMPLX(XSC * MIN(ABS(U(p,p)),ABS(U(q,q))),\r
- $ ZERO)\r
-* U(p,q) = - TEMP1 * ( U(q,p) / ABS(U(q,p)) )\r
- U(p,q) = - CTEMP\r
- 9971 CONTINUE\r
- 9970 CONTINUE\r
- ELSE\r
- CALL CLASET('U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )\r
- END IF\r
-\r
- CALL CGESVJ( 'L', 'U', 'V', NR, NR, U, LDU, SVA,\r
- $ N, V, LDV, CWORK(2*N+N*NR+1), LWORK-2*N-N*NR,\r
- $ RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
-\r
- IF ( NR .LT. N ) THEN\r
- CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )\r
- CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )\r
- CALL CLASET( 'A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV )\r
- END IF\r
-\r
- CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),\r
- $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )\r
-*\r
-* Permute the rows of V using the (column) permutation from the\r
-* first QRF. Also, scale the columns to make them unit in\r
-* Euclidean norm. This applies to all cases.\r
-*\r
- TEMP1 = SQRT(REAL(N)) * EPSLN\r
- DO 7972 q = 1, N\r
- DO 8972 p = 1, N\r
- CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)\r
- 8972 CONTINUE\r
- DO 8973 p = 1, N\r
- V(p,q) = CWORK(2*N+N*NR+NR+p)\r
- 8973 CONTINUE\r
- XSC = ONE / SCNRM2( N, V(1,q), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL CSSCAL( N, XSC, V(1,q), 1 )\r
- 7972 CONTINUE\r
-*\r
-* At this moment, V contains the right singular vectors of A.\r
-* Next, assemble the left singular vector matrix U (M x N).\r
-*\r
- IF ( NR .LT. M ) THEN\r
- CALL CLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU )\r
- IF ( NR .LT. N1 ) THEN\r
- CALL CLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU)\r
- CALL CLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1),LDU)\r
- END IF\r
- END IF\r
-*\r
- CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,\r
- $ LDU, CWORK(N+1), LWORK-N, IERR )\r
-*\r
- IF ( ROWPIV )\r
- $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )\r
-*\r
-*\r
- END IF\r
- IF ( TRANSP ) THEN\r
-* .. swap U and V because the procedure worked on A^*\r
- DO 6974 p = 1, N\r
- CALL CSWAP( N, U(1,p), 1, V(1,p), 1 )\r
- 6974 CONTINUE\r
- END IF\r
-*\r
- END IF\r
-* end of the full SVD\r
-*\r
-* Undo scaling, if necessary (and possible)\r
-*\r
- IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN\r
- CALL SLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR )\r
- USCAL1 = ONE\r
- USCAL2 = ONE\r
- END IF\r
-*\r
- IF ( NR .LT. N ) THEN\r
- DO 3004 p = NR+1, N\r
- SVA(p) = ZERO\r
- 3004 CONTINUE\r
- END IF\r
-*\r
- RWORK(1) = USCAL2 * SCALEM\r
- RWORK(2) = USCAL1\r
- IF ( ERREST ) RWORK(3) = SCONDA\r
- IF ( LSVEC .AND. RSVEC ) THEN\r
- RWORK(4) = CONDR1\r
- RWORK(5) = CONDR2\r
- END IF\r
- IF ( L2TRAN ) THEN\r
- RWORK(6) = ENTRA\r
- RWORK(7) = ENTRAT\r
- END IF\r
-*\r
- IWORK(1) = NR\r
- IWORK(2) = NUMRANK\r
- IWORK(3) = WARNING\r
- IF ( TRANSP ) THEN\r
- IWORK(4) = 1 \r
- ELSE\r
- IWORK(4) = -1\r
- END IF \r
- \r
-*\r
- RETURN\r
-* ..\r
-* .. END OF CGEJSV\r
-* ..\r
- END\r
-*\r
+*> \brief \b CGEJSV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CGEJSV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgejsv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgejsv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgejsv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
+* M, N, A, LDA, SVA, U, LDU, V, LDV,
+* CWORK, LWORK, RWORK, LRWORK, IWORK, INFO )
+*
+* .. Scalar Arguments ..
+* IMPLICIT NONE
+* INTEGER INFO, LDA, LDU, LDV, LWORK, M, N
+* ..
+* .. Array Arguments ..
+* COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK )
+* REAL SVA( N ), RWORK( LRWORK )
+* INTEGER IWORK( * )
+* CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CGEJSV computes the singular value decomposition (SVD) of a complex M-by-N
+*> matrix [A], where M >= N. The SVD of [A] is written as
+*>
+*> [A] = [U] * [SIGMA] * [V]^*,
+*>
+*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N
+*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and
+*> [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are
+*> the singular values of [A]. The columns of [U] and [V] are the left and
+*> the right singular vectors of [A], respectively. The matrices [U] and [V]
+*> are computed and stored in the arrays U and V, respectively. The diagonal
+*> of [SIGMA] is computed and stored in the array SVA.
+*> \endverbatim
+*>
+*> Arguments:
+*> ==========
+*>
+*> \param[in] JOBA
+*> \verbatim
+*> JOBA is CHARACTER*1
+*> Specifies the level of accuracy:
+*> = 'C': This option works well (high relative accuracy) if A = B * D,
+*> with well-conditioned B and arbitrary diagonal matrix D.
+*> The accuracy cannot be spoiled by COLUMN scaling. The
+*> accuracy of the computed output depends on the condition of
+*> B, and the procedure aims at the best theoretical accuracy.
+*> The relative error max_{i=1:N}|d sigma_i| / sigma_i is
+*> bounded by f(M,N)*epsilon* cond(B), independent of D.
+*> The input matrix is preprocessed with the QRF with column
+*> pivoting. This initial preprocessing and preconditioning by
+*> a rank revealing QR factorization is common for all values of
+*> JOBA. Additional actions are specified as follows:
+*> = 'E': Computation as with 'C' with an additional estimate of the
+*> condition number of B. It provides a realistic error bound.
+*> = 'F': If A = D1 * C * D2 with ill-conditioned diagonal scalings
+*> D1, D2, and well-conditioned matrix C, this option gives
+*> higher accuracy than the 'C' option. If the structure of the
+*> input matrix is not known, and relative accuracy is
+*> desirable, then this option is advisable. The input matrix A
+*> is preprocessed with QR factorization with FULL (row and
+*> column) pivoting.
+*> = 'G' Computation as with 'F' with an additional estimate of the
+*> condition number of B, where A=B*D. If A has heavily weighted
+*> rows, then using this condition number gives too pessimistic
+*> error bound.
+*> = 'A': Small singular values are not well determined by the data
+*> and are considered as noisy; the matrix is treated as
+*> numerically rank defficient. The error in the computed
+*> singular values is bounded by f(m,n)*epsilon*||A||.
+*> The computed SVD A = U * S * V^* restores A up to
+*> f(m,n)*epsilon*||A||.
+*> This gives the procedure the licence to discard (set to zero)
+*> all singular values below N*epsilon*||A||.
+*> = 'R': Similar as in 'A'. Rank revealing property of the initial
+*> QR factorization is used do reveal (using triangular factor)
+*> a gap sigma_{r+1} < epsilon * sigma_r in which case the
+*> numerical RANK is declared to be r. The SVD is computed with
+*> absolute error bounds, but more accurately than with 'A'.
+*> \endverbatim
+*>
+*> \param[in] JOBU
+*> \verbatim
+*> JOBU is CHARACTER*1
+*> Specifies whether to compute the columns of U:
+*> = 'U': N columns of U are returned in the array U.
+*> = 'F': full set of M left sing. vectors is returned in the array U.
+*> = 'W': U may be used as workspace of length M*N. See the description
+*> of U.
+*> = 'N': U is not computed.
+*> \endverbatim
+*>
+*> \param[in] JOBV
+*> \verbatim
+*> JOBV is CHARACTER*1
+*> Specifies whether to compute the matrix V:
+*> = 'V': N columns of V are returned in the array V; Jacobi rotations
+*> are not explicitly accumulated.
+*> = 'J': N columns of V are returned in the array V, but they are
+*> computed as the product of Jacobi rotations, if JOBT .EQ. 'N'.
+*> = 'W': V may be used as workspace of length N*N. See the description
+*> of V.
+*> = 'N': V is not computed.
+*> \endverbatim
+*>
+*> \param[in] JOBR
+*> \verbatim
+*> JOBR is CHARACTER*1
+*> Specifies the RANGE for the singular values. Issues the licence to
+*> set to zero small positive singular values if they are outside
+*> specified range. If A .NE. 0 is scaled so that the largest singular
+*> value of c*A is around SQRT(BIG), BIG=SLAMCH('O'), then JOBR issues
+*> the licence to kill columns of A whose norm in c*A is less than
+*> SQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN,
+*> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E').
+*> = 'N': Do not kill small columns of c*A. This option assumes that
+*> BLAS and QR factorizations and triangular solvers are
+*> implemented to work in that range. If the condition of A
+*> is greater than BIG, use CGESVJ.
+*> = 'R': RESTRICTED range for sigma(c*A) is [SQRT(SFMIN), SQRT(BIG)]
+*> (roughly, as described above). This option is recommended.
+*> ===========================
+*> For computing the singular values in the FULL range [SFMIN,BIG]
+*> use CGESVJ.
+*> \endverbatim
+*>
+*> \param[in] JOBT
+*> \verbatim
+*> JOBT is CHARACTER*1
+*> If the matrix is square then the procedure may determine to use
+*> transposed A if A^* seems to be better with respect to convergence.
+*> If the matrix is not square, JOBT is ignored.
+*> The decision is based on two values of entropy over the adjoint
+*> orbit of A^* * A. See the descriptions of WORK(6) and WORK(7).
+*> = 'T': transpose if entropy test indicates possibly faster
+*> convergence of Jacobi process if A^* is taken as input. If A is
+*> replaced with A^*, then the row pivoting is included automatically.
+*> = 'N': do not speculate.
+*> The option 'T' can be used to compute only the singular values, or
+*> the full SVD (U, SIGMA and V). For only one set of singular vectors
+*> (U or V), the caller should provide both U and V, as one of the
+*> matrices is used as workspace if the matrix A is transposed.
+*> The implementer can easily remove this constraint and make the
+*> code more complicated. See the descriptions of U and V.
+*> In general, this option is considered experimental, and 'N'; should
+*> be preferred. This is subject to changes in the future.
+*> \endverbatim
+*>
+*> \param[in] JOBP
+*> \verbatim
+*> JOBP is CHARACTER*1
+*> Issues the licence to introduce structured perturbations to drown
+*> denormalized numbers. This licence should be active if the
+*> denormals are poorly implemented, causing slow computation,
+*> especially in cases of fast convergence (!). For details see [1,2].
+*> For the sake of simplicity, this perturbations are included only
+*> when the full SVD or only the singular values are requested. The
+*> implementer/user can easily add the perturbation for the cases of
+*> computing one set of singular vectors.
+*> = 'P': introduce perturbation
+*> = 'N': do not perturb
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the input matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the input matrix A. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> On entry, the M-by-N matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] SVA
+*> \verbatim
+*> SVA is REAL array, dimension (N)
+*> On exit,
+*> - For WORK(1)/WORK(2) = ONE: The singular values of A. During the
+*> computation SVA contains Euclidean column norms of the
+*> iterated matrices in the array A.
+*> - For WORK(1) .NE. WORK(2): The singular values of A are
+*> (WORK(1)/WORK(2)) * SVA(1:N). This factored form is used if
+*> sigma_max(A) overflows or if small singular values have been
+*> saved from underflow by scaling the input matrix A.
+*> - If JOBR='R' then some of the singular values may be returned
+*> as exact zeros obtained by "set to zero" because they are
+*> below the numerical rank threshold or are denormalized numbers.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*> U is COMPLEX array, dimension ( LDU, N ) or ( LDU, M )
+*> If JOBU = 'U', then U contains on exit the M-by-N matrix of
+*> the left singular vectors.
+*> If JOBU = 'F', then U contains on exit the M-by-M matrix of
+*> the left singular vectors, including an ONB
+*> of the orthogonal complement of the Range(A).
+*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N),
+*> then U is used as workspace if the procedure
+*> replaces A with A^*. In that case, [V] is computed
+*> in U as left singular vectors of A^* and then
+*> copied back to the V array. This 'W' option is just
+*> a reminder to the caller that in this case U is
+*> reserved as workspace of length N*N.
+*> If JOBU = 'N' U is not referenced, unless JOBT='T'.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*> LDU is INTEGER
+*> The leading dimension of the array U, LDU >= 1.
+*> IF JOBU = 'U' or 'F' or 'W', then LDU >= M.
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*> V is COMPLEX array, dimension ( LDV, N )
+*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of
+*> the right singular vectors;
+*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N),
+*> then V is used as workspace if the pprocedure
+*> replaces A with A^*. In that case, [U] is computed
+*> in V as right singular vectors of A^* and then
+*> copied back to the U array. This 'W' option is just
+*> a reminder to the caller that in this case V is
+*> reserved as workspace of length N*N.
+*> If JOBV = 'N' V is not referenced, unless JOBT='T'.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V, LDV >= 1.
+*> If JOBV = 'V' or 'J' or 'W', then LDV >= N.
+*> \endverbatim
+*>
+*> \param[out] CWORK
+*> \verbatim
+*> CWORK is COMPLEX array, dimension (MAX(2,LWORK))
+*> If the call to CGEJSV is a workspace query (indicated by LWORK=-1 or
+*> LRWORK=-1), then on exit CWORK(1) contains the required length of
+*> CWORK for the job parameters used in the call.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> Length of CWORK to confirm proper allocation of workspace.
+*> LWORK depends on the job:
+*>
+*> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and
+*> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'):
+*> LWORK >= 2*N+1. This is the minimal requirement.
+*> ->> For optimal performance (blocked code) the optimal value
+*> is LWORK >= N + (N+1)*NB. Here NB is the optimal
+*> block size for CGEQP3 and CGEQRF.
+*> In general, optimal LWORK is computed as
+*> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CGEQRF), LWORK(CGESVJ)).
+*> 1.2. .. an estimate of the scaled condition number of A is
+*> required (JOBA='E', or 'G'). In this case, LWORK the minimal
+*> requirement is LWORK >= N*N + 2*N.
+*> ->> For optimal performance (blocked code) the optimal value
+*> is LWORK >= max(N+(N+1)*NB, N*N+2*N)=N**2+2*N.
+*> In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CGEQRF), LWORK(CGESVJ),
+*> N*N+LWORK(CPOCON)).
+*> 2. If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'),
+*> (JOBU.EQ.'N')
+*> 2.1 .. no scaled condition estimate requested (JOBE.EQ.'N'):
+*> -> the minimal requirement is LWORK >= 3*N.
+*> -> For optimal performance,
+*> LWORK >= max(N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,
+*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQ,
+*> CUNMLQ. In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(CGEQP3), N+LWORK(CGESVJ),
+*> N+LWORK(CGELQF), 2*N+LWORK(CGEQRF), N+LWORK(CUNMLQ)).
+*> 2.2 .. an estimate of the scaled condition number of A is
+*> required (JOBA='E', or 'G').
+*> -> the minimal requirement is LWORK >= 3*N.
+*> -> For optimal performance,
+*> LWORK >= max(N+(N+1)*NB, 2*N,2*N+N*NB)=2*N+N*NB,
+*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQ,
+*> CUNMLQ. In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(CGEQP3), LWORK(CPOCON), N+LWORK(CGESVJ),
+*> N+LWORK(CGELQF), 2*N+LWORK(CGEQRF), N+LWORK(CUNMLQ)).
+*> 3. If SIGMA and the left singular vectors are needed
+*> 3.1 .. no scaled condition estimate requested (JOBE.EQ.'N'):
+*> -> the minimal requirement is LWORK >= 3*N.
+*> -> For optimal performance:
+*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,
+*> where NB is the optimal block size for CGEQP3, CGEQRF, CUNMQR.
+*> In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(CGEQP3), 2*N+LWORK(CGEQRF), N+LWORK(CUNMQR)).
+*> 3.2 .. an estimate of the scaled condition number of A is
+*> required (JOBA='E', or 'G').
+*> -> the minimal requirement is LWORK >= 3*N.
+*> -> For optimal performance:
+*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,
+*> where NB is the optimal block size for CGEQP3, CGEQRF, CUNMQR.
+*> In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CPOCON),
+*> 2*N+LWORK(CGEQRF), N+LWORK(CUNMQR)).
+*>
+*> 4. If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and
+*> 4.1. if JOBV.EQ.'V'
+*> the minimal requirement is LWORK >= 5*N+2*N*N.
+*> 4.2. if JOBV.EQ.'J' the minimal requirement is
+*> LWORK >= 4*N+N*N.
+*> In both cases, the allocated CWORK can accommodate blocked runs
+*> of CGEQP3, CGEQRF, CGELQF, CUNMQR, CUNMLQ.
+*>
+*> If the call to CGEJSV is a workspace query (indicated by LWORK=-1 or
+*> LRWORK=-1), then on exit CWORK(1) contains the optimal and CWORK(2) contains the
+*> minimal length of CWORK for the job parameters used in the call.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is REAL array, dimension (MAX(7,LWORK))
+*> On exit,
+*> RWORK(1) = Determines the scaling factor SCALE = RWORK(2) / RWORK(1)
+*> such that SCALE*SVA(1:N) are the computed singular values
+*> of A. (See the description of SVA().)
+*> RWORK(2) = See the description of RWORK(1).
+*> RWORK(3) = SCONDA is an estimate for the condition number of
+*> column equilibrated A. (If JOBA .EQ. 'E' or 'G')
+*> SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1).
+*> It is computed using SPOCON. It holds
+*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA
+*> where R is the triangular factor from the QRF of A.
+*> However, if R is truncated and the numerical rank is
+*> determined to be strictly smaller than N, SCONDA is
+*> returned as -1, thus indicating that the smallest
+*> singular values might be lost.
+*>
+*> If full SVD is needed, the following two condition numbers are
+*> useful for the analysis of the algorithm. They are provied for
+*> a developer/implementer who is familiar with the details of
+*> the method.
+*>
+*> RWORK(4) = an estimate of the scaled condition number of the
+*> triangular factor in the first QR factorization.
+*> RWORK(5) = an estimate of the scaled condition number of the
+*> triangular factor in the second QR factorization.
+*> The following two parameters are computed if JOBT .EQ. 'T'.
+*> They are provided for a developer/implementer who is familiar
+*> with the details of the method.
+*> RWORK(6) = the entropy of A^* * A :: this is the Shannon entropy
+*> of diag(A^* * A) / Trace(A^* * A) taken as point in the
+*> probability simplex.
+*> RWORK(7) = the entropy of A * A^*. (See the description of RWORK(6).)
+*> If the call to CGEJSV is a workspace query (indicated by LWORK=-1 or
+*> LRWORK=-1), then on exit RWORK(1) contains the required length of
+*> RWORK for the job parameters used in the call.
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*> LRWORK is INTEGER
+*> Length of RWORK to confirm proper allocation of workspace.
+*> LRWORK depends on the job:
+*>
+*> 1. If only the singular values are requested i.e. if
+*> LSAME(JOBU,'N') .AND. LSAME(JOBV,'N')
+*> then:
+*> 1.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),
+*> then: LRWORK = max( 7, 2 * M ).
+*> 1.2. Otherwise, LRWORK = max( 7, N ).
+*> 2. If singular values with the right singular vectors are requested
+*> i.e. if
+*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) .AND.
+*> .NOT.(LSAME(JOBU,'U').OR.LSAME(JOBU,'F'))
+*> then:
+*> 2.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),
+*> then LRWORK = max( 7, 2 * M ).
+*> 2.2. Otherwise, LRWORK = max( 7, N ).
+*> 3. If singular values with the left singular vectors are requested, i.e. if
+*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND.
+*> .NOT.(LSAME(JOBV,'V').OR.LSAME(JOBV,'J'))
+*> then:
+*> 3.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),
+*> then LRWORK = max( 7, 2 * M ).
+*> 3.2. Otherwise, LRWORK = max( 7, N ).
+*> 4. If singular values with both the left and the right singular vectors
+*> are requested, i.e. if
+*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND.
+*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J'))
+*> then:
+*> 4.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),
+*> then LRWORK = max( 7, 2 * M ).
+*> 4.2. Otherwise, LRWORK = max( 7, N ).
+*>
+*> If, on entry, LRWORK = -1 or LWORK=-1, a workspace query is assumed and
+*> the length of RWORK is returned in RWORK(1).
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, of dimension at least 4, that further depends
+*> on the job:
+*>
+*> 1. If only the singular values are requested then:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is N+M; otherwise the length of IWORK is N.
+*> 2. If the singular values and the right singular vectors are requested then:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is N+M; otherwise the length of IWORK is N.
+*> 3. If the singular values and the left singular vectors are requested then:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is N+M; otherwise the length of IWORK is N.
+*> 4. If the singular values with both the left and the right singular vectors
+*> are requested, then:
+*> 4.1. If LSAME(JOBV,'J') the length of IWORK is determined as follows:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is N+M; otherwise the length of IWORK is N.
+*> 4.2. If LSAME(JOBV,'V') the length of IWORK is determined as follows:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is 2*N+M; otherwise the length of IWORK is 2*N.
+*>
+*> On exit,
+*> IWORK(1) = the numerical rank determined after the initial
+*> QR factorization with pivoting. See the descriptions
+*> of JOBA and JOBR.
+*> IWORK(2) = the number of the computed nonzero singular values
+*> IWORK(3) = if nonzero, a warning message:
+*> If IWORK(3).EQ.1 then some of the column norms of A
+*> were denormalized floats. The requested high accuracy
+*> is not warranted by the data.
+*> IWORK(4) = 1 or -1. If IWORK(4) .EQ. 1, then the procedure used A^* to
+*> do the job as specified by the JOB parameters.
+*> If the call to CGEJSV is a workspace query (indicated by LWORK .EQ. -1 and
+*> LRWORK .EQ. -1), then on exit IWORK(1) contains the required length of
+*> IWORK for the job parameters used in the call.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> < 0 : if INFO = -i, then the i-th argument had an illegal value.
+*> = 0 : successful exit;
+*> > 0 : CGEJSV did not converge in the maximal allowed number
+*> of sweeps. The computed values may be inaccurate.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup complexGEsing
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*> CGEJSV implements a preconditioned Jacobi SVD algorithm. It uses CGEQP3,
+*> CGEQRF, and CGELQF as preprocessors and preconditioners. Optionally, an
+*> additional row pivoting can be used as a preprocessor, which in some
+*> cases results in much higher accuracy. An example is matrix A with the
+*> structure A = D1 * C * D2, where D1, D2 are arbitrarily ill-conditioned
+*> diagonal matrices and C is well-conditioned matrix. In that case, complete
+*> pivoting in the first QR factorizations provides accuracy dependent on the
+*> condition number of C, and independent of D1, D2. Such higher accuracy is
+*> not completely understood theoretically, but it works well in practice.
+*> Further, if A can be written as A = B*D, with well-conditioned B and some
+*> diagonal D, then the high accuracy is guaranteed, both theoretically and
+*> in software, independent of D. For more details see [1], [2].
+*> The computational range for the singular values can be the full range
+*> ( UNDERFLOW,OVERFLOW ), provided that the machine arithmetic and the BLAS
+*> & LAPACK routines called by CGEJSV are implemented to work in that range.
+*> If that is not the case, then the restriction for safe computation with
+*> the singular values in the range of normalized IEEE numbers is that the
+*> spectral condition number kappa(A)=sigma_max(A)/sigma_min(A) does not
+*> overflow. This code (CGEJSV) is best used in this restricted range,
+*> meaning that singular values of magnitude below ||A||_2 / SLAMCH('O') are
+*> returned as zeros. See JOBR for details on this.
+*> Further, this implementation is somewhat slower than the one described
+*> in [1,2] due to replacement of some non-LAPACK components, and because
+*> the choice of some tuning parameters in the iterative part (CGESVJ) is
+*> left to the implementer on a particular machine.
+*> The rank revealing QR factorization (in this code: CGEQP3) should be
+*> implemented as in [3]. We have a new version of CGEQP3 under development
+*> that is more robust than the current one in LAPACK, with a cleaner cut in
+*> rank deficient cases. It will be available in the SIGMA library [4].
+*> If M is much larger than N, it is obvious that the initial QRF with
+*> column pivoting can be preprocessed by the QRF without pivoting. That
+*> well known trick is not used in CGEJSV because in some cases heavy row
+*> weighting can be treated with complete pivoting. The overhead in cases
+*> M much larger than N is then only due to pivoting, but the benefits in
+*> terms of accuracy have prevailed. The implementer/user can incorporate
+*> this extra QRF step easily. The implementer can also improve data movement
+*> (matrix transpose, matrix copy, matrix transposed copy) - this
+*> implementation of CGEJSV uses only the simplest, naive data movement.
+*> \endverbatim
+*
+*> \par Contributor:
+* ==================
+*>
+*> Zlatko Drmac (Zagreb, Croatia)
+*
+*> \par References:
+* ================
+*>
+*> \verbatim
+*>
+*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I.
+*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342.
+*> LAPACK Working note 169.
+*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II.
+*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362.
+*> LAPACK Working note 170.
+*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR
+*> factorization software - a case study.
+*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28.
+*> LAPACK Working note 176.
+*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV,
+*> QSVD, (H,K)-SVD computations.
+*> Department of Mathematics, University of Zagreb, 2008, 2016.
+*> \endverbatim
+*
+*> \par Bugs, examples and comments:
+* =================================
+*>
+*> Please report all bugs and send interesting examples and/or comments to
+*> drmac@math.hr. Thank you.
+*>
+* =====================================================================
+ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
+ $ M, N, A, LDA, SVA, U, LDU, V, LDV,
+ $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.7.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* June 2017
+*
+* .. Scalar Arguments ..
+ IMPLICIT NONE
+ INTEGER INFO, LDA, LDU, LDV, LWORK, LRWORK, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK )
+ REAL SVA( N ), RWORK( LRWORK )
+ INTEGER IWORK( * )
+ CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV
+* ..
+*
+* ===========================================================================
+*
+* .. Local Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
+ COMPLEX CZERO, CONE
+ PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ), CONE = ( 1.0E0, 0.0E0 ) )
+* ..
+* .. Local Scalars ..
+ COMPLEX CTEMP
+ REAL AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1, COND_OK,
+ $ CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN, MAXPRJ, SCALEM,
+ $ SCONDA, SFMIN, SMALL, TEMP1, USCAL1, USCAL2, XSC
+ INTEGER IERR, N1, NR, NUMRANK, p, q, WARNING
+ LOGICAL ALMORT, DEFR, ERREST, GOSCAL, JRACC, KILL, LQUERY,
+ $ LSVEC, L2ABER, L2KILL, L2PERT, L2RANK, L2TRAN, NOSCAL,
+ $ ROWPIV, RSVEC, TRANSP
+*
+ INTEGER OPTWRK, MINWRK, MINRWRK, MINIWRK
+ INTEGER LWCON, LWLQF, LWQP3, LWQRF, LWUNMLQ, LWUNMQR, LWUNMQRM,
+ $ LWSVDJ, LWSVDJV, LRWQP3, LRWCON, LRWSVDJ, IWOFF
+ INTEGER LWRK_CGELQF, LWRK_CGEQP3, LWRK_CGEQP3N, LWRK_CGEQRF,
+ $ LWRK_CGESVJ, LWRK_CGESVJV, LWRK_CGESVJU, LWRK_CUNMLQ,
+ $ LWRK_CUNMQR, LWRK_CUNMQRM
+* ..
+* .. Local Arrays
+ COMPLEX CDUMMY(1)
+ REAL RDUMMY(1)
+*
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, CMPLX, CONJG, ALOG, MAX, MIN, REAL, NINT, SQRT
+* ..
+* .. External Functions ..
+ REAL SLAMCH, SCNRM2
+ INTEGER ISAMAX, ICAMAX
+ LOGICAL LSAME
+ EXTERNAL ISAMAX, ICAMAX, LSAME, SLAMCH, SCNRM2
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLASSQ, CCOPY, CGELQF, CGEQP3, CGEQRF, CLACPY, CLAPMR,
+ $ CLASCL, SLASCL, CLASET, CLASSQ, CLASWP, CUNGQR, CUNMLQ,
+ $ CUNMQR, CPOCON, SSCAL, CSSCAL, CSWAP, CTRSM, CLACGV,
+ $ XERBLA
+*
+ EXTERNAL CGESVJ
+* ..
+*
+* Test the input arguments
+*
+ LSVEC = LSAME( JOBU, 'U' ) .OR. LSAME( JOBU, 'F' )
+ JRACC = LSAME( JOBV, 'J' )
+ RSVEC = LSAME( JOBV, 'V' ) .OR. JRACC
+ ROWPIV = LSAME( JOBA, 'F' ) .OR. LSAME( JOBA, 'G' )
+ L2RANK = LSAME( JOBA, 'R' )
+ L2ABER = LSAME( JOBA, 'A' )
+ ERREST = LSAME( JOBA, 'E' ) .OR. LSAME( JOBA, 'G' )
+ L2TRAN = LSAME( JOBT, 'T' ) .AND. ( M .EQ. N )
+ L2KILL = LSAME( JOBR, 'R' )
+ DEFR = LSAME( JOBR, 'N' )
+ L2PERT = LSAME( JOBP, 'P' )
+*
+ LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 )
+*
+ IF ( .NOT.(ROWPIV .OR. L2RANK .OR. L2ABER .OR.
+ $ ERREST .OR. LSAME( JOBA, 'C' ) )) THEN
+ INFO = - 1
+ ELSE IF ( .NOT.( LSVEC .OR. LSAME( JOBU, 'N' ) .OR.
+ $ ( LSAME( JOBU, 'W' ) .AND. RSVEC .AND. L2TRAN ) ) ) THEN
+ INFO = - 2
+ ELSE IF ( .NOT.( RSVEC .OR. LSAME( JOBV, 'N' ) .OR.
+ $ ( LSAME( JOBV, 'W' ) .AND. LSVEC .AND. L2TRAN ) ) ) THEN
+ INFO = - 3
+ ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN
+ INFO = - 4
+ ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. LSAME(JOBT,'N') ) ) THEN
+ INFO = - 5
+ ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN
+ INFO = - 6
+ ELSE IF ( M .LT. 0 ) THEN
+ INFO = - 7
+ ELSE IF ( ( N .LT. 0 ) .OR. ( N .GT. M ) ) THEN
+ INFO = - 8
+ ELSE IF ( LDA .LT. M ) THEN
+ INFO = - 10
+ ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN
+ INFO = - 13
+ ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN
+ INFO = - 15
+ ELSE
+* #:)
+ INFO = 0
+ END IF
+*
+ IF ( INFO .EQ. 0 ) THEN
+* .. compute the minimal and the optimal workspace lengths
+* [[The expressions for computing the minimal and the optimal
+* values of LCWORK, LRWORK are written with a lot of redundancy and
+* can be simplified. However, this verbose form is useful for
+* maintenance and modifications of the code.]]
+*
+* .. minimal workspace length for CGEQP3 of an M x N matrix,
+* CGEQRF of an N x N matrix, CGELQF of an N x N matrix,
+* CUNMLQ for computing N x N matrix, CUNMQR for computing N x N
+* matrix, CUNMQR for computing M x N matrix, respectively.
+ LWQP3 = N+1
+ LWQRF = MAX( 1, N )
+ LWLQF = MAX( 1, N )
+ LWUNMLQ = MAX( 1, N )
+ LWUNMQR = MAX( 1, N )
+ LWUNMQRM = MAX( 1, M )
+* .. minimal workspace length for CPOCON of an N x N matrix
+ LWCON = 2 * N
+* .. minimal workspace length for CGESVJ of an N x N matrix,
+* without and with explicit accumulation of Jacobi rotations
+ LWSVDJ = MAX( 2 * N, 1 )
+ LWSVDJV = MAX( 2 * N, 1 )
+* .. minimal REAL workspace length for CGEQP3, CPOCON, CGESVJ
+ LRWQP3 = N
+ LRWCON = N
+ LRWSVDJ = N
+ IF ( LQUERY ) THEN
+ CALL CGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1,
+ $ RDUMMY, IERR )
+ LWRK_CGEQP3 = CDUMMY(1)
+ CALL CGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
+ LWRK_CGEQRF = CDUMMY(1)
+ CALL CGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
+ LWRK_CGELQF = CDUMMY(1)
+ END IF
+ MINWRK = 2
+ OPTWRK = 2
+ MINIWRK = N
+ IF ( .NOT. (LSVEC .OR. RSVEC ) ) THEN
+* .. minimal and optimal sizes of the complex workspace if
+* only the singular values are requested
+ IF ( ERREST ) THEN
+ MINWRK = MAX( N+LWQP3, N**2+LWCON, N+LWQRF, LWSVDJ )
+ ELSE
+ MINWRK = MAX( N+LWQP3, N+LWQRF, LWSVDJ )
+ END IF
+ IF ( LQUERY ) THEN
+ CALL CGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V,
+ $ LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_CGESVJ = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = MAX( N+LWRK_CGEQP3, N**2+LWCON,
+ $ N+LWRK_CGEQRF, LWRK_CGESVJ )
+ ELSE
+ OPTWRK = MAX( N+LWRK_CGEQP3, N+LWRK_CGEQRF,
+ $ LWRK_CGESVJ )
+ END IF
+ END IF
+ IF ( L2TRAN .OR. ROWPIV ) THEN
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWCON, LRWSVDJ )
+ ELSE
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )
+ END IF
+ ELSE
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, LRWQP3, LRWCON, LRWSVDJ )
+ ELSE
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )
+ END IF
+ END IF
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN
+* .. minimal and optimal sizes of the complex workspace if the
+* singular values and the right singular vectors are requested
+ IF ( ERREST ) THEN
+ MINWRK = MAX( N+LWQP3, LWCON, LWSVDJ, N+LWLQF,
+ $ 2*N+LWQRF, N+LWSVDJ, N+LWUNMLQ )
+ ELSE
+ MINWRK = MAX( N+LWQP3, LWSVDJ, N+LWLQF, 2*N+LWQRF,
+ $ N+LWSVDJ, N+LWUNMLQ )
+ END IF
+ IF ( LQUERY ) THEN
+ CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
+ $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_CGESVJ = CDUMMY(1)
+ CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
+ $ V, LDV, CDUMMY, -1, IERR )
+ LWRK_CUNMLQ = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = MAX( N+LWRK_CGEQP3, LWCON, LWRK_CGESVJ,
+ $ N+LWRK_CGELQF, 2*N+LWRK_CGEQRF,
+ $ N+LWRK_CGESVJ, N+LWRK_CUNMLQ )
+ ELSE
+ OPTWRK = MAX( N+LWRK_CGEQP3, LWRK_CGESVJ,N+LWRK_CGELQF,
+ $ 2*N+LWRK_CGEQRF, N+LWRK_CGESVJ,
+ $ N+LWRK_CUNMLQ )
+ END IF
+ END IF
+ IF ( L2TRAN .OR. ROWPIV ) THEN
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )
+ END IF
+ ELSE
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )
+ END IF
+ END IF
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN
+* .. minimal and optimal sizes of the complex workspace if the
+* singular values and the left singular vectors are requested
+ IF ( ERREST ) THEN
+ MINWRK = N + MAX( LWQP3,LWCON,N+LWQRF,LWSVDJ,LWUNMQRM )
+ ELSE
+ MINWRK = N + MAX( LWQP3, N+LWQRF, LWSVDJ, LWUNMQRM )
+ END IF
+ IF ( LQUERY ) THEN
+ CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
+ $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_CGESVJ = CDUMMY(1)
+ CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
+ $ LDU, CDUMMY, -1, IERR )
+ LWRK_CUNMQRM = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = N + MAX( LWRK_CGEQP3, LWCON, N+LWRK_CGEQRF,
+ $ LWRK_CGESVJ, LWRK_CUNMQRM )
+ ELSE
+ OPTWRK = N + MAX( LWRK_CGEQP3, N+LWRK_CGEQRF,
+ $ LWRK_CGESVJ, LWRK_CUNMQRM )
+ END IF
+ END IF
+ IF ( L2TRAN .OR. ROWPIV ) THEN
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )
+ END IF
+ ELSE
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )
+ END IF
+ END IF
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ ELSE
+* .. minimal and optimal sizes of the complex workspace if the
+* full SVD is requested
+ IF ( .NOT. JRACC ) THEN
+ IF ( ERREST ) THEN
+ MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+N**2+LWCON,
+ $ 2*N+LWQRF, 2*N+LWQP3,
+ $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON,
+ $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV,
+ $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ,
+ $ N+N**2+LWSVDJ, N+LWUNMQRM )
+ ELSE
+ MINWRK = MAX( N+LWQP3, 2*N+N**2+LWCON,
+ $ 2*N+LWQRF, 2*N+LWQP3,
+ $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON,
+ $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV,
+ $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ,
+ $ N+N**2+LWSVDJ, N+LWUNMQRM )
+ END IF
+ MINIWRK = MINIWRK + N
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ ELSE
+ IF ( ERREST ) THEN
+ MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+LWQRF,
+ $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR,
+ $ N+LWUNMQRM )
+ ELSE
+ MINWRK = MAX( N+LWQP3, 2*N+LWQRF,
+ $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR,
+ $ N+LWUNMQRM )
+ END IF
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ END IF
+ IF ( LQUERY ) THEN
+ CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
+ $ LDU, CDUMMY, -1, IERR )
+ LWRK_CUNMQRM = CDUMMY(1)
+ CALL CUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U,
+ $ LDU, CDUMMY, -1, IERR )
+ LWRK_CUNMQR = CDUMMY(1)
+ IF ( .NOT. JRACC ) THEN
+ CALL CGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1,
+ $ RDUMMY, IERR )
+ LWRK_CGEQP3N = CDUMMY(1)
+ CALL CGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA,
+ $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_CGESVJ = CDUMMY(1)
+ CALL CGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA,
+ $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_CGESVJU = CDUMMY(1)
+ CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
+ $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_CGESVJV = CDUMMY(1)
+ CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
+ $ V, LDV, CDUMMY, -1, IERR )
+ LWRK_CUNMLQ = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON,
+ $ 2*N+N**2+LWCON, 2*N+LWRK_CGEQRF,
+ $ 2*N+LWRK_CGEQP3N,
+ $ 2*N+N**2+N+LWRK_CGELQF,
+ $ 2*N+N**2+N+N**2+LWCON,
+ $ 2*N+N**2+N+LWRK_CGESVJ,
+ $ 2*N+N**2+N+LWRK_CGESVJV,
+ $ 2*N+N**2+N+LWRK_CUNMQR,
+ $ 2*N+N**2+N+LWRK_CUNMLQ,
+ $ N+N**2+LWRK_CGESVJU,
+ $ N+LWRK_CUNMQRM )
+ ELSE
+ OPTWRK = MAX( N+LWRK_CGEQP3,
+ $ 2*N+N**2+LWCON, 2*N+LWRK_CGEQRF,
+ $ 2*N+LWRK_CGEQP3N,
+ $ 2*N+N**2+N+LWRK_CGELQF,
+ $ 2*N+N**2+N+N**2+LWCON,
+ $ 2*N+N**2+N+LWRK_CGESVJ,
+ $ 2*N+N**2+N+LWRK_CGESVJV,
+ $ 2*N+N**2+N+LWRK_CUNMQR,
+ $ 2*N+N**2+N+LWRK_CUNMLQ,
+ $ N+N**2+LWRK_CGESVJU,
+ $ N+LWRK_CUNMQRM )
+ END IF
+ ELSE
+ CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
+ $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_CGESVJV = CDUMMY(1)
+ CALL CUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY,
+ $ V, LDV, CDUMMY, -1, IERR )
+ LWRK_CUNMQR = CDUMMY(1)
+ CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
+ $ LDU, CDUMMY, -1, IERR )
+ LWRK_CUNMQRM = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON,
+ $ 2*N+LWRK_CGEQRF, 2*N+N**2,
+ $ 2*N+N**2+LWRK_CGESVJV,
+ $ 2*N+N**2+N+LWRK_CUNMQR,N+LWRK_CUNMQRM )
+ ELSE
+ OPTWRK = MAX( N+LWRK_CGEQP3, 2*N+LWRK_CGEQRF,
+ $ 2*N+N**2, 2*N+N**2+LWRK_CGESVJV,
+ $ 2*N+N**2+N+LWRK_CUNMQR,
+ $ N+LWRK_CUNMQRM )
+ END IF
+ END IF
+ END IF
+ IF ( L2TRAN .OR. ROWPIV ) THEN
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )
+ END IF
+ END IF
+ MINWRK = MAX( 2, MINWRK )
+ OPTWRK = MAX( 2, OPTWRK )
+ IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = - 17
+ IF ( LRWORK .LT. MINRWRK .AND. (.NOT.LQUERY) ) INFO = - 19
+ END IF
+*
+ IF ( INFO .NE. 0 ) THEN
+* #:(
+ CALL XERBLA( 'CGEJSV', - INFO )
+ RETURN
+ ELSE IF ( LQUERY ) THEN
+ CWORK(1) = OPTWRK
+ CWORK(2) = MINWRK
+ RWORK(1) = MINRWRK
+ IWORK(1) = MAX( 4, MINIWRK )
+ RETURN
+ END IF
+*
+* Quick return for void matrix (Y3K safe)
+* #:)
+ IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN
+ IWORK(1:4) = 0
+ RWORK(1:7) = 0
+ RETURN
+ ENDIF
+*
+* Determine whether the matrix U should be M x N or M x M
+*
+ IF ( LSVEC ) THEN
+ N1 = N
+ IF ( LSAME( JOBU, 'F' ) ) N1 = M
+ END IF
+*
+* Set numerical parameters
+*
+*! NOTE: Make sure SLAMCH() does not fail on the target architecture.
+*
+ EPSLN = SLAMCH('Epsilon')
+ SFMIN = SLAMCH('SafeMinimum')
+ SMALL = SFMIN / EPSLN
+ BIG = SLAMCH('O')
+* BIG = ONE / SFMIN
+*
+* Initialize SVA(1:N) = diag( ||A e_i||_2 )_1^N
+*
+*(!) If necessary, scale SVA() to protect the largest norm from
+* overflow. It is possible that this scaling pushes the smallest
+* column norm left from the underflow threshold (extreme case).
+*
+ SCALEM = ONE / SQRT(REAL(M)*REAL(N))
+ NOSCAL = .TRUE.
+ GOSCAL = .TRUE.
+ DO 1874 p = 1, N
+ AAPP = ZERO
+ AAQQ = ONE
+ CALL CLASSQ( M, A(1,p), 1, AAPP, AAQQ )
+ IF ( AAPP .GT. BIG ) THEN
+ INFO = - 9
+ CALL XERBLA( 'CGEJSV', -INFO )
+ RETURN
+ END IF
+ AAQQ = SQRT(AAQQ)
+ IF ( ( AAPP .LT. (BIG / AAQQ) ) .AND. NOSCAL ) THEN
+ SVA(p) = AAPP * AAQQ
+ ELSE
+ NOSCAL = .FALSE.
+ SVA(p) = AAPP * ( AAQQ * SCALEM )
+ IF ( GOSCAL ) THEN
+ GOSCAL = .FALSE.
+ CALL SSCAL( p-1, SCALEM, SVA, 1 )
+ END IF
+ END IF
+ 1874 CONTINUE
+*
+ IF ( NOSCAL ) SCALEM = ONE
+*
+ AAPP = ZERO
+ AAQQ = BIG
+ DO 4781 p = 1, N
+ AAPP = MAX( AAPP, SVA(p) )
+ IF ( SVA(p) .NE. ZERO ) AAQQ = MIN( AAQQ, SVA(p) )
+ 4781 CONTINUE
+*
+* Quick return for zero M x N matrix
+* #:)
+ IF ( AAPP .EQ. ZERO ) THEN
+ IF ( LSVEC ) CALL CLASET( 'G', M, N1, CZERO, CONE, U, LDU )
+ IF ( RSVEC ) CALL CLASET( 'G', N, N, CZERO, CONE, V, LDV )
+ RWORK(1) = ONE
+ RWORK(2) = ONE
+ IF ( ERREST ) RWORK(3) = ONE
+ IF ( LSVEC .AND. RSVEC ) THEN
+ RWORK(4) = ONE
+ RWORK(5) = ONE
+ END IF
+ IF ( L2TRAN ) THEN
+ RWORK(6) = ZERO
+ RWORK(7) = ZERO
+ END IF
+ IWORK(1) = 0
+ IWORK(2) = 0
+ IWORK(3) = 0
+ IWORK(4) = -1
+ RETURN
+ END IF
+*
+* Issue warning if denormalized column norms detected. Override the
+* high relative accuracy request. Issue licence to kill nonzero columns
+* (set them to zero) whose norm is less than sigma_max / BIG (roughly).
+* #:(
+ WARNING = 0
+ IF ( AAQQ .LE. SFMIN ) THEN
+ L2RANK = .TRUE.
+ L2KILL = .TRUE.
+ WARNING = 1
+ END IF
+*
+* Quick return for one-column matrix
+* #:)
+ IF ( N .EQ. 1 ) THEN
+*
+ IF ( LSVEC ) THEN
+ CALL CLASCL( 'G',0,0,SVA(1),SCALEM, M,1,A(1,1),LDA,IERR )
+ CALL CLACPY( 'A', M, 1, A, LDA, U, LDU )
+* computing all M left singular vectors of the M x 1 matrix
+ IF ( N1 .NE. N ) THEN
+ CALL CGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N,IERR )
+ CALL CUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N,IERR )
+ CALL CCOPY( M, A(1,1), 1, U(1,1), 1 )
+ END IF
+ END IF
+ IF ( RSVEC ) THEN
+ V(1,1) = CONE
+ END IF
+ IF ( SVA(1) .LT. (BIG*SCALEM) ) THEN
+ SVA(1) = SVA(1) / SCALEM
+ SCALEM = ONE
+ END IF
+ RWORK(1) = ONE / SCALEM
+ RWORK(2) = ONE
+ IF ( SVA(1) .NE. ZERO ) THEN
+ IWORK(1) = 1
+ IF ( ( SVA(1) / SCALEM) .GE. SFMIN ) THEN
+ IWORK(2) = 1
+ ELSE
+ IWORK(2) = 0
+ END IF
+ ELSE
+ IWORK(1) = 0
+ IWORK(2) = 0
+ END IF
+ IWORK(3) = 0
+ IWORK(4) = -1
+ IF ( ERREST ) RWORK(3) = ONE
+ IF ( LSVEC .AND. RSVEC ) THEN
+ RWORK(4) = ONE
+ RWORK(5) = ONE
+ END IF
+ IF ( L2TRAN ) THEN
+ RWORK(6) = ZERO
+ RWORK(7) = ZERO
+ END IF
+ RETURN
+*
+ END IF
+*
+ TRANSP = .FALSE.
+*
+ AATMAX = -ONE
+ AATMIN = BIG
+ IF ( ROWPIV .OR. L2TRAN ) THEN
+*
+* Compute the row norms, needed to determine row pivoting sequence
+* (in the case of heavily row weighted A, row pivoting is strongly
+* advised) and to collect information needed to compare the
+* structures of A * A^* and A^* * A (in the case L2TRAN.EQ..TRUE.).
+*
+ IF ( L2TRAN ) THEN
+ DO 1950 p = 1, M
+ XSC = ZERO
+ TEMP1 = ONE
+ CALL CLASSQ( N, A(p,1), LDA, XSC, TEMP1 )
+* CLASSQ gets both the ell_2 and the ell_infinity norm
+* in one pass through the vector
+ RWORK(M+p) = XSC * SCALEM
+ RWORK(p) = XSC * (SCALEM*SQRT(TEMP1))
+ AATMAX = MAX( AATMAX, RWORK(p) )
+ IF (RWORK(p) .NE. ZERO)
+ $ AATMIN = MIN(AATMIN,RWORK(p))
+ 1950 CONTINUE
+ ELSE
+ DO 1904 p = 1, M
+ RWORK(M+p) = SCALEM*ABS( A(p,ICAMAX(N,A(p,1),LDA)) )
+ AATMAX = MAX( AATMAX, RWORK(M+p) )
+ AATMIN = MIN( AATMIN, RWORK(M+p) )
+ 1904 CONTINUE
+ END IF
+*
+ END IF
+*
+* For square matrix A try to determine whether A^* would be better
+* input for the preconditioned Jacobi SVD, with faster convergence.
+* The decision is based on an O(N) function of the vector of column
+* and row norms of A, based on the Shannon entropy. This should give
+* the right choice in most cases when the difference actually matters.
+* It may fail and pick the slower converging side.
+*
+ ENTRA = ZERO
+ ENTRAT = ZERO
+ IF ( L2TRAN ) THEN
+*
+ XSC = ZERO
+ TEMP1 = ONE
+ CALL SLASSQ( N, SVA, 1, XSC, TEMP1 )
+ TEMP1 = ONE / TEMP1
+*
+ ENTRA = ZERO
+ DO 1113 p = 1, N
+ BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1
+ IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * ALOG(BIG1)
+ 1113 CONTINUE
+ ENTRA = - ENTRA / ALOG(REAL(N))
+*
+* Now, SVA().^2/Trace(A^* * A) is a point in the probability simplex.
+* It is derived from the diagonal of A^* * A. Do the same with the
+* diagonal of A * A^*, compute the entropy of the corresponding
+* probability distribution. Note that A * A^* and A^* * A have the
+* same trace.
+*
+ ENTRAT = ZERO
+ DO 1114 p = 1, M
+ BIG1 = ( ( RWORK(p) / XSC )**2 ) * TEMP1
+ IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * ALOG(BIG1)
+ 1114 CONTINUE
+ ENTRAT = - ENTRAT / ALOG(REAL(M))
+*
+* Analyze the entropies and decide A or A^*. Smaller entropy
+* usually means better input for the algorithm.
+*
+ TRANSP = ( ENTRAT .LT. ENTRA )
+*
+* If A^* is better than A, take the adjoint of A. This is allowed
+* only for square matrices, M=N.
+ IF ( TRANSP ) THEN
+* In an optimal implementation, this trivial transpose
+* should be replaced with faster transpose.
+ DO 1115 p = 1, N - 1
+ A(p,p) = CONJG(A(p,p))
+ DO 1116 q = p + 1, N
+ CTEMP = CONJG(A(q,p))
+ A(q,p) = CONJG(A(p,q))
+ A(p,q) = CTEMP
+ 1116 CONTINUE
+ 1115 CONTINUE
+ A(N,N) = CONJG(A(N,N))
+ DO 1117 p = 1, N
+ RWORK(M+p) = SVA(p)
+ SVA(p) = RWORK(p)
+* previously computed row 2-norms are now column 2-norms
+* of the transposed matrix
+ 1117 CONTINUE
+ TEMP1 = AAPP
+ AAPP = AATMAX
+ AATMAX = TEMP1
+ TEMP1 = AAQQ
+ AAQQ = AATMIN
+ AATMIN = TEMP1
+ KILL = LSVEC
+ LSVEC = RSVEC
+ RSVEC = KILL
+ IF ( LSVEC ) N1 = N
+*
+ ROWPIV = .TRUE.
+ END IF
+*
+ END IF
+* END IF L2TRAN
+*
+* Scale the matrix so that its maximal singular value remains less
+* than SQRT(BIG) -- the matrix is scaled so that its maximal column
+* has Euclidean norm equal to SQRT(BIG/N). The only reason to keep
+* SQRT(BIG) instead of BIG is the fact that CGEJSV uses LAPACK and
+* BLAS routines that, in some implementations, are not capable of
+* working in the full interval [SFMIN,BIG] and that they may provoke
+* overflows in the intermediate results. If the singular values spread
+* from SFMIN to BIG, then CGESVJ will compute them. So, in that case,
+* one should use CGESVJ instead of CGEJSV.
+ BIG1 = SQRT( BIG )
+ TEMP1 = SQRT( BIG / REAL(N) )
+* >> for future updates: allow bigger range, i.e. the largest column
+* will be allowed up to BIG/N and CGESVJ will do the rest. However, for
+* this all other (LAPACK) components must allow such a range.
+* TEMP1 = BIG/REAL(N)
+* TEMP1 = BIG * EPSLN this should 'almost' work with current LAPACK components
+ CALL SLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR )
+ IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN
+ AAQQ = ( AAQQ / AAPP ) * TEMP1
+ ELSE
+ AAQQ = ( AAQQ * TEMP1 ) / AAPP
+ END IF
+ TEMP1 = TEMP1 * SCALEM
+ CALL CLASCL( 'G', 0, 0, AAPP, TEMP1, M, N, A, LDA, IERR )
+*
+* To undo scaling at the end of this procedure, multiply the
+* computed singular values with USCAL2 / USCAL1.
+*
+ USCAL1 = TEMP1
+ USCAL2 = AAPP
+*
+ IF ( L2KILL ) THEN
+* L2KILL enforces computation of nonzero singular values in
+* the restricted range of condition number of the initial A,
+* sigma_max(A) / sigma_min(A) approx. SQRT(BIG)/SQRT(SFMIN).
+ XSC = SQRT( SFMIN )
+ ELSE
+ XSC = SMALL
+*
+* Now, if the condition number of A is too big,
+* sigma_max(A) / sigma_min(A) .GT. SQRT(BIG/N) * EPSLN / SFMIN,
+* as a precaution measure, the full SVD is computed using CGESVJ
+* with accumulated Jacobi rotations. This provides numerically
+* more robust computation, at the cost of slightly increased run
+* time. Depending on the concrete implementation of BLAS and LAPACK
+* (i.e. how they behave in presence of extreme ill-conditioning) the
+* implementor may decide to remove this switch.
+ IF ( ( AAQQ.LT.SQRT(SFMIN) ) .AND. LSVEC .AND. RSVEC ) THEN
+ JRACC = .TRUE.
+ END IF
+*
+ END IF
+ IF ( AAQQ .LT. XSC ) THEN
+ DO 700 p = 1, N
+ IF ( SVA(p) .LT. XSC ) THEN
+ CALL CLASET( 'A', M, 1, CZERO, CZERO, A(1,p), LDA )
+ SVA(p) = ZERO
+ END IF
+ 700 CONTINUE
+ END IF
+*
+* Preconditioning using QR factorization with pivoting
+*
+ IF ( ROWPIV ) THEN
+* Optional row permutation (Bjoerck row pivoting):
+* A result by Cox and Higham shows that the Bjoerck's
+* row pivoting combined with standard column pivoting
+* has similar effect as Powell-Reid complete pivoting.
+* The ell-infinity norms of A are made nonincreasing.
+ IF ( ( LSVEC .AND. RSVEC ) .AND. .NOT.( JRACC ) ) THEN
+ IWOFF = 2*N
+ ELSE
+ IWOFF = N
+ END IF
+ DO 1952 p = 1, M - 1
+ q = ISAMAX( M-p+1, RWORK(M+p), 1 ) + p - 1
+ IWORK(IWOFF+p) = q
+ IF ( p .NE. q ) THEN
+ TEMP1 = RWORK(M+p)
+ RWORK(M+p) = RWORK(M+q)
+ RWORK(M+q) = TEMP1
+ END IF
+ 1952 CONTINUE
+ CALL CLASWP( N, A, LDA, 1, M-1, IWORK(IWOFF+1), 1 )
+ END IF
+*
+* End of the preparation phase (scaling, optional sorting and
+* transposing, optional flushing of small columns).
+*
+* Preconditioning
+*
+* If the full SVD is needed, the right singular vectors are computed
+* from a matrix equation, and for that we need theoretical analysis
+* of the Businger-Golub pivoting. So we use CGEQP3 as the first RR QRF.
+* In all other cases the first RR QRF can be chosen by other criteria
+* (eg speed by replacing global with restricted window pivoting, such
+* as in xGEQPX from TOMS # 782). Good results will be obtained using
+* xGEQPX with properly (!) chosen numerical parameters.
+* Any improvement of CGEQP3 improves overal performance of CGEJSV.
+*
+* A * P1 = Q1 * [ R1^* 0]^*:
+ DO 1963 p = 1, N
+* .. all columns are free columns
+ IWORK(p) = 0
+ 1963 CONTINUE
+ CALL CGEQP3( M, N, A, LDA, IWORK, CWORK, CWORK(N+1), LWORK-N,
+ $ RWORK, IERR )
+*
+* The upper triangular matrix R1 from the first QRF is inspected for
+* rank deficiency and possibilities for deflation, or possible
+* ill-conditioning. Depending on the user specified flag L2RANK,
+* the procedure explores possibilities to reduce the numerical
+* rank by inspecting the computed upper triangular factor. If
+* L2RANK or L2ABER are up, then CGEJSV will compute the SVD of
+* A + dA, where ||dA|| <= f(M,N)*EPSLN.
+*
+ NR = 1
+ IF ( L2ABER ) THEN
+* Standard absolute error bound suffices. All sigma_i with
+* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an
+* agressive enforcement of lower numerical rank by introducing a
+* backward error of the order of N*EPSLN*||A||.
+ TEMP1 = SQRT(REAL(N))*EPSLN
+ DO 3001 p = 2, N
+ IF ( ABS(A(p,p)) .GE. (TEMP1*ABS(A(1,1))) ) THEN
+ NR = NR + 1
+ ELSE
+ GO TO 3002
+ END IF
+ 3001 CONTINUE
+ 3002 CONTINUE
+ ELSE IF ( L2RANK ) THEN
+* .. similarly as above, only slightly more gentle (less agressive).
+* Sudden drop on the diagonal of R1 is used as the criterion for
+* close-to-rank-defficient.
+ TEMP1 = SQRT(SFMIN)
+ DO 3401 p = 2, N
+ IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR.
+ $ ( ABS(A(p,p)) .LT. SMALL ) .OR.
+ $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3402
+ NR = NR + 1
+ 3401 CONTINUE
+ 3402 CONTINUE
+*
+ ELSE
+* The goal is high relative accuracy. However, if the matrix
+* has high scaled condition number the relative accuracy is in
+* general not feasible. Later on, a condition number estimator
+* will be deployed to estimate the scaled condition number.
+* Here we just remove the underflowed part of the triangular
+* factor. This prevents the situation in which the code is
+* working hard to get the accuracy not warranted by the data.
+ TEMP1 = SQRT(SFMIN)
+ DO 3301 p = 2, N
+ IF ( ( ABS(A(p,p)) .LT. SMALL ) .OR.
+ $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3302
+ NR = NR + 1
+ 3301 CONTINUE
+ 3302 CONTINUE
+*
+ END IF
+*
+ ALMORT = .FALSE.
+ IF ( NR .EQ. N ) THEN
+ MAXPRJ = ONE
+ DO 3051 p = 2, N
+ TEMP1 = ABS(A(p,p)) / SVA(IWORK(p))
+ MAXPRJ = MIN( MAXPRJ, TEMP1 )
+ 3051 CONTINUE
+ IF ( MAXPRJ**2 .GE. ONE - REAL(N)*EPSLN ) ALMORT = .TRUE.
+ END IF
+*
+*
+ SCONDA = - ONE
+ CONDR1 = - ONE
+ CONDR2 = - ONE
+*
+ IF ( ERREST ) THEN
+ IF ( N .EQ. NR ) THEN
+ IF ( RSVEC ) THEN
+* .. V is available as workspace
+ CALL CLACPY( 'U', N, N, A, LDA, V, LDV )
+ DO 3053 p = 1, N
+ TEMP1 = SVA(IWORK(p))
+ CALL CSSCAL( p, ONE/TEMP1, V(1,p), 1 )
+ 3053 CONTINUE
+ IF ( LSVEC )THEN
+ CALL CPOCON( 'U', N, V, LDV, ONE, TEMP1,
+ $ CWORK(N+1), RWORK, IERR )
+ ELSE
+ CALL CPOCON( 'U', N, V, LDV, ONE, TEMP1,
+ $ CWORK, RWORK, IERR )
+ END IF
+*
+ ELSE IF ( LSVEC ) THEN
+* .. U is available as workspace
+ CALL CLACPY( 'U', N, N, A, LDA, U, LDU )
+ DO 3054 p = 1, N
+ TEMP1 = SVA(IWORK(p))
+ CALL CSSCAL( p, ONE/TEMP1, U(1,p), 1 )
+ 3054 CONTINUE
+ CALL CPOCON( 'U', N, U, LDU, ONE, TEMP1,
+ $ CWORK(N+1), RWORK, IERR )
+ ELSE
+ CALL CLACPY( 'U', N, N, A, LDA, CWORK, N )
+*[] CALL CLACPY( 'U', N, N, A, LDA, CWORK(N+1), N )
+* Change: here index shifted by N to the left, CWORK(1:N)
+* not needed for SIGMA only computation
+ DO 3052 p = 1, N
+ TEMP1 = SVA(IWORK(p))
+*[] CALL CSSCAL( p, ONE/TEMP1, CWORK(N+(p-1)*N+1), 1 )
+ CALL CSSCAL( p, ONE/TEMP1, CWORK((p-1)*N+1), 1 )
+ 3052 CONTINUE
+* .. the columns of R are scaled to have unit Euclidean lengths.
+*[] CALL CPOCON( 'U', N, CWORK(N+1), N, ONE, TEMP1,
+*[] $ CWORK(N+N*N+1), RWORK, IERR )
+ CALL CPOCON( 'U', N, CWORK, N, ONE, TEMP1,
+ $ CWORK(N*N+1), RWORK, IERR )
+*
+ END IF
+ IF ( TEMP1 .NE. ZERO ) THEN
+ SCONDA = ONE / SQRT(TEMP1)
+ ELSE
+ SCONDA = - ONE
+ END IF
+* SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1).
+* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA
+ ELSE
+ SCONDA = - ONE
+ END IF
+ END IF
+*
+ L2PERT = L2PERT .AND. ( ABS( A(1,1)/A(NR,NR) ) .GT. SQRT(BIG1) )
+* If there is no violent scaling, artificial perturbation is not needed.
+*
+* Phase 3:
+*
+ IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN
+*
+* Singular Values only
+*
+* .. transpose A(1:NR,1:N)
+ DO 1946 p = 1, MIN( N-1, NR )
+ CALL CCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 )
+ CALL CLACGV( N-p+1, A(p,p), 1 )
+ 1946 CONTINUE
+ IF ( NR .EQ. N ) A(N,N) = CONJG(A(N,N))
+*
+* The following two DO-loops introduce small relative perturbation
+* into the strict upper triangle of the lower triangular matrix.
+* Small entries below the main diagonal are also changed.
+* This modification is useful if the computing environment does not
+* provide/allow FLUSH TO ZERO underflow, for it prevents many
+* annoying denormalized numbers in case of strongly scaled matrices.
+* The perturbation is structured so that it does not introduce any
+* new perturbation of the singular values, and it does not destroy
+* the job done by the preconditioner.
+* The licence for this perturbation is in the variable L2PERT, which
+* should be .FALSE. if FLUSH TO ZERO underflow is active.
+*
+ IF ( .NOT. ALMORT ) THEN
+*
+ IF ( L2PERT ) THEN
+* XSC = SQRT(SMALL)
+ XSC = EPSLN / REAL(N)
+ DO 4947 q = 1, NR
+ CTEMP = CMPLX(XSC*ABS(A(q,q)),ZERO)
+ DO 4949 p = 1, N
+ IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )
+ $ .OR. ( p .LT. q ) )
+* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) )
+ $ A(p,q) = CTEMP
+ 4949 CONTINUE
+ 4947 CONTINUE
+ ELSE
+ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, A(1,2),LDA )
+ END IF
+*
+* .. second preconditioning using the QR factorization
+*
+ CALL CGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, IERR )
+*
+* .. and transpose upper to lower triangular
+ DO 1948 p = 1, NR - 1
+ CALL CCOPY( NR-p, A(p,p+1), LDA, A(p+1,p), 1 )
+ CALL CLACGV( NR-p+1, A(p,p), 1 )
+ 1948 CONTINUE
+*
+ END IF
+*
+* Row-cyclic Jacobi SVD algorithm with column pivoting
+*
+* .. again some perturbation (a "background noise") is added
+* to drown denormals
+ IF ( L2PERT ) THEN
+* XSC = SQRT(SMALL)
+ XSC = EPSLN / REAL(N)
+ DO 1947 q = 1, NR
+ CTEMP = CMPLX(XSC*ABS(A(q,q)),ZERO)
+ DO 1949 p = 1, NR
+ IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )
+ $ .OR. ( p .LT. q ) )
+* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) )
+ $ A(p,q) = CTEMP
+ 1949 CONTINUE
+ 1947 CONTINUE
+ ELSE
+ CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), LDA )
+ END IF
+*
+* .. and one-sided Jacobi rotations are started on a lower
+* triangular matrix (plus perturbation which is ignored in
+* the part which destroys triangular form (confusing?!))
+*
+ CALL CGESVJ( 'L', 'N', 'N', NR, NR, A, LDA, SVA,
+ $ N, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO )
+*
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+*
+*
+ ELSE IF ( ( RSVEC .AND. ( .NOT. LSVEC ) .AND. ( .NOT. JRACC ) )
+ $ .OR.
+ $ ( JRACC .AND. ( .NOT. LSVEC ) .AND. ( NR .NE. N ) ) ) THEN
+*
+* -> Singular Values and Right Singular Vectors <-
+*
+ IF ( ALMORT ) THEN
+*
+* .. in this case NR equals N
+ DO 1998 p = 1, NR
+ CALL CCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
+ CALL CLACGV( N-p+1, V(p,p), 1 )
+ 1998 CONTINUE
+ CALL CLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV )
+*
+ CALL CGESVJ( 'L','U','N', N, NR, V, LDV, SVA, NR, A, LDA,
+ $ CWORK, LWORK, RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+
+ ELSE
+*
+* .. two more QR factorizations ( one QRF is not enough, two require
+* accumulated product of Jacobi rotations, three are perfect )
+*
+ CALL CLASET( 'L', NR-1,NR-1, CZERO, CZERO, A(2,1), LDA )
+ CALL CGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, IERR)
+ CALL CLACPY( 'L', NR, NR, A, LDA, V, LDV )
+ CALL CLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV )
+ CALL CGEQRF( NR, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),
+ $ LWORK-2*N, IERR )
+ DO 8998 p = 1, NR
+ CALL CCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 )
+ CALL CLACGV( NR-p+1, V(p,p), 1 )
+ 8998 CONTINUE
+ CALL CLASET('U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV)
+*
+ CALL CGESVJ( 'L', 'U','N', NR, NR, V,LDV, SVA, NR, U,
+ $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ IF ( NR .LT. N ) THEN
+ CALL CLASET( 'A',N-NR, NR, CZERO,CZERO, V(NR+1,1), LDV )
+ CALL CLASET( 'A',NR, N-NR, CZERO,CZERO, V(1,NR+1), LDV )
+ CALL CLASET( 'A',N-NR,N-NR,CZERO,CONE, V(NR+1,NR+1),LDV )
+ END IF
+*
+ CALL CUNMLQ( 'L', 'C', N, N, NR, A, LDA, CWORK,
+ $ V, LDV, CWORK(N+1), LWORK-N, IERR )
+*
+ END IF
+* .. permute the rows of V
+* DO 8991 p = 1, N
+* CALL CCOPY( N, V(p,1), LDV, A(IWORK(p),1), LDA )
+* 8991 CONTINUE
+* CALL CLACPY( 'All', N, N, A, LDA, V, LDV )
+ CALL CLAPMR( .FALSE., N, N, V, LDV, IWORK )
+*
+ IF ( TRANSP ) THEN
+ CALL CLACPY( 'A', N, N, V, LDV, U, LDU )
+ END IF
+*
+ ELSE IF ( JRACC .AND. (.NOT. LSVEC) .AND. ( NR.EQ. N ) ) THEN
+*
+ CALL CLASET( 'L', N-1,N-1, CZERO, CZERO, A(2,1), LDA )
+*
+ CALL CGESVJ( 'U','N','V', N, N, A, LDA, SVA, N, V, LDV,
+ $ CWORK, LWORK, RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ CALL CLAPMR( .FALSE., N, N, V, LDV, IWORK )
+*
+ ELSE IF ( LSVEC .AND. ( .NOT. RSVEC ) ) THEN
+*
+* .. Singular Values and Left Singular Vectors ..
+*
+* .. second preconditioning step to avoid need to accumulate
+* Jacobi rotations in the Jacobi iterations.
+ DO 1965 p = 1, NR
+ CALL CCOPY( N-p+1, A(p,p), LDA, U(p,p), 1 )
+ CALL CLACGV( N-p+1, U(p,p), 1 )
+ 1965 CONTINUE
+ CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )
+*
+ CALL CGEQRF( N, NR, U, LDU, CWORK(N+1), CWORK(2*N+1),
+ $ LWORK-2*N, IERR )
+*
+ DO 1967 p = 1, NR - 1
+ CALL CCOPY( NR-p, U(p,p+1), LDU, U(p+1,p), 1 )
+ CALL CLACGV( N-p+1, U(p,p), 1 )
+ 1967 CONTINUE
+ CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )
+*
+ CALL CGESVJ( 'L', 'U', 'N', NR,NR, U, LDU, SVA, NR, A,
+ $ LDA, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+*
+ IF ( NR .LT. M ) THEN
+ CALL CLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), LDU )
+ IF ( NR .LT. N1 ) THEN
+ CALL CLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU )
+ CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1),LDU )
+ END IF
+ END IF
+*
+ CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,
+ $ LDU, CWORK(N+1), LWORK-N, IERR )
+*
+ IF ( ROWPIV )
+ $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )
+*
+ DO 1974 p = 1, N1
+ XSC = ONE / SCNRM2( M, U(1,p), 1 )
+ CALL CSSCAL( M, XSC, U(1,p), 1 )
+ 1974 CONTINUE
+*
+ IF ( TRANSP ) THEN
+ CALL CLACPY( 'A', N, N, U, LDU, V, LDV )
+ END IF
+*
+ ELSE
+*
+* .. Full SVD ..
+*
+ IF ( .NOT. JRACC ) THEN
+*
+ IF ( .NOT. ALMORT ) THEN
+*
+* Second Preconditioning Step (QRF [with pivoting])
+* Note that the composition of TRANSPOSE, QRF and TRANSPOSE is
+* equivalent to an LQF CALL. Since in many libraries the QRF
+* seems to be better optimized than the LQF, we do explicit
+* transpose and use the QRF. This is subject to changes in an
+* optimized implementation of CGEJSV.
+*
+ DO 1968 p = 1, NR
+ CALL CCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
+ CALL CLACGV( N-p+1, V(p,p), 1 )
+ 1968 CONTINUE
+*
+* .. the following two loops perturb small entries to avoid
+* denormals in the second QR factorization, where they are
+* as good as zeros. This is done to avoid painfully slow
+* computation with denormals. The relative size of the perturbation
+* is a parameter that can be changed by the implementer.
+* This perturbation device will be obsolete on machines with
+* properly implemented arithmetic.
+* To switch it off, set L2PERT=.FALSE. To remove it from the
+* code, remove the action under L2PERT=.TRUE., leave the ELSE part.
+* The following two loops should be blocked and fused with the
+* transposed copy above.
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 2969 q = 1, NR
+ CTEMP = CMPLX(XSC*ABS( V(q,q) ),ZERO)
+ DO 2968 p = 1, N
+ IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )
+ $ .OR. ( p .LT. q ) )
+* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) )
+ $ V(p,q) = CTEMP
+ IF ( p .LT. q ) V(p,q) = - V(p,q)
+ 2968 CONTINUE
+ 2969 CONTINUE
+ ELSE
+ CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV )
+ END IF
+*
+* Estimate the row scaled condition number of R1
+* (If R1 is rectangular, N > NR, then the condition number
+* of the leading NR x NR submatrix is estimated.)
+*
+ CALL CLACPY( 'L', NR, NR, V, LDV, CWORK(2*N+1), NR )
+ DO 3950 p = 1, NR
+ TEMP1 = SCNRM2(NR-p+1,CWORK(2*N+(p-1)*NR+p),1)
+ CALL CSSCAL(NR-p+1,ONE/TEMP1,CWORK(2*N+(p-1)*NR+p),1)
+ 3950 CONTINUE
+ CALL CPOCON('L',NR,CWORK(2*N+1),NR,ONE,TEMP1,
+ $ CWORK(2*N+NR*NR+1),RWORK,IERR)
+ CONDR1 = ONE / SQRT(TEMP1)
+* .. here need a second oppinion on the condition number
+* .. then assume worst case scenario
+* R1 is OK for inverse <=> CONDR1 .LT. REAL(N)
+* more conservative <=> CONDR1 .LT. SQRT(REAL(N))
+*
+ COND_OK = SQRT(SQRT(REAL(NR)))
+*[TP] COND_OK is a tuning parameter.
+*
+ IF ( CONDR1 .LT. COND_OK ) THEN
+* .. the second QRF without pivoting. Note: in an optimized
+* implementation, this QRF should be implemented as the QRF
+* of a lower triangular matrix.
+* R1^* = Q2 * R2
+ CALL CGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),
+ $ LWORK-2*N, IERR )
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)/EPSLN
+ DO 3959 p = 2, NR
+ DO 3958 q = 1, p - 1
+ CTEMP=CMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),
+ $ ZERO)
+ IF ( ABS(V(q,p)) .LE. TEMP1 )
+* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) )
+ $ V(q,p) = CTEMP
+ 3958 CONTINUE
+ 3959 CONTINUE
+ END IF
+*
+ IF ( NR .NE. N )
+ $ CALL CLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N )
+* .. save ...
+*
+* .. this transposed copy should be better than naive
+ DO 1969 p = 1, NR - 1
+ CALL CCOPY( NR-p, V(p,p+1), LDV, V(p+1,p), 1 )
+ CALL CLACGV(NR-p+1, V(p,p), 1 )
+ 1969 CONTINUE
+ V(NR,NR)=CONJG(V(NR,NR))
+*
+ CONDR2 = CONDR1
+*
+ ELSE
+*
+* .. ill-conditioned case: second QRF with pivoting
+* Note that windowed pivoting would be equaly good
+* numerically, and more run-time efficient. So, in
+* an optimal implementation, the next call to CGEQP3
+* should be replaced with eg. CALL CGEQPX (ACM TOMS #782)
+* with properly (carefully) chosen parameters.
+*
+* R1^* * P2 = Q2 * R2
+ DO 3003 p = 1, NR
+ IWORK(N+p) = 0
+ 3003 CONTINUE
+ CALL CGEQP3( N, NR, V, LDV, IWORK(N+1), CWORK(N+1),
+ $ CWORK(2*N+1), LWORK-2*N, RWORK, IERR )
+** CALL CGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),
+** $ LWORK-2*N, IERR )
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 3969 p = 2, NR
+ DO 3968 q = 1, p - 1
+ CTEMP=CMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),
+ $ ZERO)
+ IF ( ABS(V(q,p)) .LE. TEMP1 )
+* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) )
+ $ V(q,p) = CTEMP
+ 3968 CONTINUE
+ 3969 CONTINUE
+ END IF
+*
+ CALL CLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N )
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 8970 p = 2, NR
+ DO 8971 q = 1, p - 1
+ CTEMP=CMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),
+ $ ZERO)
+* V(p,q) = - TEMP1*( V(q,p) / ABS(V(q,p)) )
+ V(p,q) = - CTEMP
+ 8971 CONTINUE
+ 8970 CONTINUE
+ ELSE
+ CALL CLASET( 'L',NR-1,NR-1,CZERO,CZERO,V(2,1),LDV )
+ END IF
+* Now, compute R2 = L3 * Q3, the LQ factorization.
+ CALL CGELQF( NR, NR, V, LDV, CWORK(2*N+N*NR+1),
+ $ CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, IERR )
+* .. and estimate the condition number
+ CALL CLACPY( 'L',NR,NR,V,LDV,CWORK(2*N+N*NR+NR+1),NR )
+ DO 4950 p = 1, NR
+ TEMP1 = SCNRM2( p, CWORK(2*N+N*NR+NR+p), NR )
+ CALL CSSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), NR )
+ 4950 CONTINUE
+ CALL CPOCON( 'L',NR,CWORK(2*N+N*NR+NR+1),NR,ONE,TEMP1,
+ $ CWORK(2*N+N*NR+NR+NR*NR+1),RWORK,IERR )
+ CONDR2 = ONE / SQRT(TEMP1)
+*
+*
+ IF ( CONDR2 .GE. COND_OK ) THEN
+* .. save the Householder vectors used for Q3
+* (this overwrittes the copy of R2, as it will not be
+* needed in this branch, but it does not overwritte the
+* Huseholder vectors of Q2.).
+ CALL CLACPY( 'U', NR, NR, V, LDV, CWORK(2*N+1), N )
+* .. and the rest of the information on Q3 is in
+* WORK(2*N+N*NR+1:2*N+N*NR+N)
+ END IF
+*
+ END IF
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 4968 q = 2, NR
+ CTEMP = XSC * V(q,q)
+ DO 4969 p = 1, q - 1
+* V(p,q) = - TEMP1*( V(p,q) / ABS(V(p,q)) )
+ V(p,q) = - CTEMP
+ 4969 CONTINUE
+ 4968 CONTINUE
+ ELSE
+ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV )
+ END IF
+*
+* Second preconditioning finished; continue with Jacobi SVD
+* The input matrix is lower trinagular.
+*
+* Recover the right singular vectors as solution of a well
+* conditioned triangular matrix equation.
+*
+ IF ( CONDR1 .LT. COND_OK ) THEN
+*
+ CALL CGESVJ( 'L','U','N',NR,NR,V,LDV,SVA,NR,U, LDU,
+ $ CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,RWORK,
+ $ LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ DO 3970 p = 1, NR
+ CALL CCOPY( NR, V(1,p), 1, U(1,p), 1 )
+ CALL CSSCAL( NR, SVA(p), V(1,p), 1 )
+ 3970 CONTINUE
+
+* .. pick the right matrix equation and solve it
+*
+ IF ( NR .EQ. N ) THEN
+* :)) .. best case, R1 is inverted. The solution of this matrix
+* equation is Q2*V2 = the product of the Jacobi rotations
+* used in CGESVJ, premultiplied with the orthogonal matrix
+* from the second QR factorization.
+ CALL CTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V,LDV)
+ ELSE
+* .. R1 is well conditioned, but non-square. Adjoint of R2
+* is inverted to get the product of the Jacobi rotations
+* used in CGESVJ. The Q-factor from the second QR
+* factorization is then built in explicitly.
+ CALL CTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1),
+ $ N,V,LDV)
+ IF ( NR .LT. N ) THEN
+ CALL CLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV)
+ CALL CLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV)
+ CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)
+ END IF
+ CALL CUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),
+ $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR)
+ END IF
+*
+ ELSE IF ( CONDR2 .LT. COND_OK ) THEN
+*
+* The matrix R2 is inverted. The solution of the matrix equation
+* is Q3^* * V3 = the product of the Jacobi rotations (appplied to
+* the lower triangular L3 from the LQ factorization of
+* R2=L3*Q3), pre-multiplied with the transposed Q3.
+ CALL CGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U,
+ $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR,
+ $ RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ DO 3870 p = 1, NR
+ CALL CCOPY( NR, V(1,p), 1, U(1,p), 1 )
+ CALL CSSCAL( NR, SVA(p), U(1,p), 1 )
+ 3870 CONTINUE
+ CALL CTRSM('L','U','N','N',NR,NR,CONE,CWORK(2*N+1),N,
+ $ U,LDU)
+* .. apply the permutation from the second QR factorization
+ DO 873 q = 1, NR
+ DO 872 p = 1, NR
+ CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)
+ 872 CONTINUE
+ DO 874 p = 1, NR
+ U(p,q) = CWORK(2*N+N*NR+NR+p)
+ 874 CONTINUE
+ 873 CONTINUE
+ IF ( NR .LT. N ) THEN
+ CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )
+ CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )
+ CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)
+ END IF
+ CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),
+ $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
+ ELSE
+* Last line of defense.
+* #:( This is a rather pathological case: no scaled condition
+* improvement after two pivoted QR factorizations. Other
+* possibility is that the rank revealing QR factorization
+* or the condition estimator has failed, or the COND_OK
+* is set very close to ONE (which is unnecessary). Normally,
+* this branch should never be executed, but in rare cases of
+* failure of the RRQR or condition estimator, the last line of
+* defense ensures that CGEJSV completes the task.
+* Compute the full SVD of L3 using CGESVJ with explicit
+* accumulation of Jacobi rotations.
+ CALL CGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U,
+ $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR,
+ $ RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ IF ( NR .LT. N ) THEN
+ CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )
+ CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )
+ CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)
+ END IF
+ CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),
+ $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
+*
+ CALL CUNMLQ( 'L', 'C', NR, NR, NR, CWORK(2*N+1), N,
+ $ CWORK(2*N+N*NR+1), U, LDU, CWORK(2*N+N*NR+NR+1),
+ $ LWORK-2*N-N*NR-NR, IERR )
+ DO 773 q = 1, NR
+ DO 772 p = 1, NR
+ CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)
+ 772 CONTINUE
+ DO 774 p = 1, NR
+ U(p,q) = CWORK(2*N+N*NR+NR+p)
+ 774 CONTINUE
+ 773 CONTINUE
+*
+ END IF
+*
+* Permute the rows of V using the (column) permutation from the
+* first QRF. Also, scale the columns to make them unit in
+* Euclidean norm. This applies to all cases.
+*
+ TEMP1 = SQRT(REAL(N)) * EPSLN
+ DO 1972 q = 1, N
+ DO 972 p = 1, N
+ CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)
+ 972 CONTINUE
+ DO 973 p = 1, N
+ V(p,q) = CWORK(2*N+N*NR+NR+p)
+ 973 CONTINUE
+ XSC = ONE / SCNRM2( N, V(1,q), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL CSSCAL( N, XSC, V(1,q), 1 )
+ 1972 CONTINUE
+* At this moment, V contains the right singular vectors of A.
+* Next, assemble the left singular vector matrix U (M x N).
+ IF ( NR .LT. M ) THEN
+ CALL CLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU)
+ IF ( NR .LT. N1 ) THEN
+ CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU)
+ CALL CLASET('A',M-NR,N1-NR,CZERO,CONE,
+ $ U(NR+1,NR+1),LDU)
+ END IF
+ END IF
+*
+* The Q matrix from the first QRF is built into the left singular
+* matrix U. This applies to all cases.
+*
+ CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,
+ $ LDU, CWORK(N+1), LWORK-N, IERR )
+
+* The columns of U are normalized. The cost is O(M*N) flops.
+ TEMP1 = SQRT(REAL(M)) * EPSLN
+ DO 1973 p = 1, NR
+ XSC = ONE / SCNRM2( M, U(1,p), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL CSSCAL( M, XSC, U(1,p), 1 )
+ 1973 CONTINUE
+*
+* If the initial QRF is computed with row pivoting, the left
+* singular vectors must be adjusted.
+*
+ IF ( ROWPIV )
+ $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )
+*
+ ELSE
+*
+* .. the initial matrix A has almost orthogonal columns and
+* the second QRF is not needed
+*
+ CALL CLACPY( 'U', N, N, A, LDA, CWORK(N+1), N )
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 5970 p = 2, N
+ CTEMP = XSC * CWORK( N + (p-1)*N + p )
+ DO 5971 q = 1, p - 1
+* CWORK(N+(q-1)*N+p)=-TEMP1 * ( CWORK(N+(p-1)*N+q) /
+* $ ABS(CWORK(N+(p-1)*N+q)) )
+ CWORK(N+(q-1)*N+p)=-CTEMP
+ 5971 CONTINUE
+ 5970 CONTINUE
+ ELSE
+ CALL CLASET( 'L',N-1,N-1,CZERO,CZERO,CWORK(N+2),N )
+ END IF
+*
+ CALL CGESVJ( 'U', 'U', 'N', N, N, CWORK(N+1), N, SVA,
+ $ N, U, LDU, CWORK(N+N*N+1), LWORK-N-N*N, RWORK, LRWORK,
+ $ INFO )
+*
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ DO 6970 p = 1, N
+ CALL CCOPY( N, CWORK(N+(p-1)*N+1), 1, U(1,p), 1 )
+ CALL CSSCAL( N, SVA(p), CWORK(N+(p-1)*N+1), 1 )
+ 6970 CONTINUE
+*
+ CALL CTRSM( 'L', 'U', 'N', 'N', N, N,
+ $ CONE, A, LDA, CWORK(N+1), N )
+ DO 6972 p = 1, N
+ CALL CCOPY( N, CWORK(N+p), N, V(IWORK(p),1), LDV )
+ 6972 CONTINUE
+ TEMP1 = SQRT(REAL(N))*EPSLN
+ DO 6971 p = 1, N
+ XSC = ONE / SCNRM2( N, V(1,p), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL CSSCAL( N, XSC, V(1,p), 1 )
+ 6971 CONTINUE
+*
+* Assemble the left singular vector matrix U (M x N).
+*
+ IF ( N .LT. M ) THEN
+ CALL CLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), LDU )
+ IF ( N .LT. N1 ) THEN
+ CALL CLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1),LDU)
+ CALL CLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1),LDU)
+ END IF
+ END IF
+ CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,
+ $ LDU, CWORK(N+1), LWORK-N, IERR )
+ TEMP1 = SQRT(REAL(M))*EPSLN
+ DO 6973 p = 1, N1
+ XSC = ONE / SCNRM2( M, U(1,p), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL CSSCAL( M, XSC, U(1,p), 1 )
+ 6973 CONTINUE
+*
+ IF ( ROWPIV )
+ $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )
+*
+ END IF
+*
+* end of the >> almost orthogonal case << in the full SVD
+*
+ ELSE
+*
+* This branch deploys a preconditioned Jacobi SVD with explicitly
+* accumulated rotations. It is included as optional, mainly for
+* experimental purposes. It does perfom well, and can also be used.
+* In this implementation, this branch will be automatically activated
+* if the condition number sigma_max(A) / sigma_min(A) is predicted
+* to be greater than the overflow threshold. This is because the
+* a posteriori computation of the singular vectors assumes robust
+* implementation of BLAS and some LAPACK procedures, capable of working
+* in presence of extreme values, e.g. when the singular values spread from
+* the underflow to the overflow threshold.
+*
+ DO 7968 p = 1, NR
+ CALL CCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
+ CALL CLACGV( N-p+1, V(p,p), 1 )
+ 7968 CONTINUE
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL/EPSLN)
+ DO 5969 q = 1, NR
+ CTEMP = CMPLX(XSC*ABS( V(q,q) ),ZERO)
+ DO 5968 p = 1, N
+ IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )
+ $ .OR. ( p .LT. q ) )
+* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) )
+ $ V(p,q) = CTEMP
+ IF ( p .LT. q ) V(p,q) = - V(p,q)
+ 5968 CONTINUE
+ 5969 CONTINUE
+ ELSE
+ CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV )
+ END IF
+
+ CALL CGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),
+ $ LWORK-2*N, IERR )
+ CALL CLACPY( 'L', N, NR, V, LDV, CWORK(2*N+1), N )
+*
+ DO 7969 p = 1, NR
+ CALL CCOPY( NR-p+1, V(p,p), LDV, U(p,p), 1 )
+ CALL CLACGV( NR-p+1, U(p,p), 1 )
+ 7969 CONTINUE
+
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL/EPSLN)
+ DO 9970 q = 2, NR
+ DO 9971 p = 1, q - 1
+ CTEMP = CMPLX(XSC * MIN(ABS(U(p,p)),ABS(U(q,q))),
+ $ ZERO)
+* U(p,q) = - TEMP1 * ( U(q,p) / ABS(U(q,p)) )
+ U(p,q) = - CTEMP
+ 9971 CONTINUE
+ 9970 CONTINUE
+ ELSE
+ CALL CLASET('U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )
+ END IF
+
+ CALL CGESVJ( 'L', 'U', 'V', NR, NR, U, LDU, SVA,
+ $ N, V, LDV, CWORK(2*N+N*NR+1), LWORK-2*N-N*NR,
+ $ RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+
+ IF ( NR .LT. N ) THEN
+ CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )
+ CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )
+ CALL CLASET( 'A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV )
+ END IF
+
+ CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),
+ $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
+*
+* Permute the rows of V using the (column) permutation from the
+* first QRF. Also, scale the columns to make them unit in
+* Euclidean norm. This applies to all cases.
+*
+ TEMP1 = SQRT(REAL(N)) * EPSLN
+ DO 7972 q = 1, N
+ DO 8972 p = 1, N
+ CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)
+ 8972 CONTINUE
+ DO 8973 p = 1, N
+ V(p,q) = CWORK(2*N+N*NR+NR+p)
+ 8973 CONTINUE
+ XSC = ONE / SCNRM2( N, V(1,q), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL CSSCAL( N, XSC, V(1,q), 1 )
+ 7972 CONTINUE
+*
+* At this moment, V contains the right singular vectors of A.
+* Next, assemble the left singular vector matrix U (M x N).
+*
+ IF ( NR .LT. M ) THEN
+ CALL CLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU )
+ IF ( NR .LT. N1 ) THEN
+ CALL CLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU)
+ CALL CLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1),LDU)
+ END IF
+ END IF
+*
+ CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,
+ $ LDU, CWORK(N+1), LWORK-N, IERR )
+*
+ IF ( ROWPIV )
+ $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )
+*
+*
+ END IF
+ IF ( TRANSP ) THEN
+* .. swap U and V because the procedure worked on A^*
+ DO 6974 p = 1, N
+ CALL CSWAP( N, U(1,p), 1, V(1,p), 1 )
+ 6974 CONTINUE
+ END IF
+*
+ END IF
+* end of the full SVD
+*
+* Undo scaling, if necessary (and possible)
+*
+ IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN
+ CALL SLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR )
+ USCAL1 = ONE
+ USCAL2 = ONE
+ END IF
+*
+ IF ( NR .LT. N ) THEN
+ DO 3004 p = NR+1, N
+ SVA(p) = ZERO
+ 3004 CONTINUE
+ END IF
+*
+ RWORK(1) = USCAL2 * SCALEM
+ RWORK(2) = USCAL1
+ IF ( ERREST ) RWORK(3) = SCONDA
+ IF ( LSVEC .AND. RSVEC ) THEN
+ RWORK(4) = CONDR1
+ RWORK(5) = CONDR2
+ END IF
+ IF ( L2TRAN ) THEN
+ RWORK(6) = ENTRA
+ RWORK(7) = ENTRAT
+ END IF
+*
+ IWORK(1) = NR
+ IWORK(2) = NUMRANK
+ IWORK(3) = WARNING
+ IF ( TRANSP ) THEN
+ IWORK(4) = 1
+ ELSE
+ IWORK(4) = -1
+ END IF
+
+*
+ RETURN
+* ..
+* .. END OF CGEJSV
+* ..
+ END
+*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
*>
*> \verbatim
*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
+*> The matrix V stores the elementary reflectors H(i) in the i-th row
+*> above the diagonal. For example, if M=5 and N=3, the matrix V is
*>
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
*>
*> where the vi's represent the vectors which define H(i), which are returned
*> in the matrix A. The 1's along the diagonal of V are not stored in A.
-*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each
-*> block is of order NB except for the last block, which is of order
-*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
-*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
+*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/MB), where each
+*> block is of order MB except for the last block, which is of order
+*> IB = K - (B-1)*MB. For each of the B blocks, a upper triangular block
+*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB
+*> for the last block) T's are stored in the MB-by-K matrix T as
*>
*> T = (T1 T2 ... TB).
*> \endverbatim
* =====================================================================
SUBROUTINE CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDT, M, N, MB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
*>
*> \verbatim
*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
+*> The matrix V stores the elementary reflectors H(i) in the i-th row
+*> above the diagonal. For example, if M=5 and N=3, the matrix V is
*>
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
* =====================================================================
RECURSIVE SUBROUTINE CGELQT3( M, N, A, LDA, T, LDT, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, LDT
PARAMETER ( ZERO = (0.0E+00,0.0E+00))
* ..
* .. Local Scalars ..
- INTEGER I, I1, J, J1, M1, M2, N1, N2, IINFO
+ INTEGER I, I1, J, J1, M1, M2, IINFO
* ..
* .. External Subroutines ..
EXTERNAL CLARFG, CTRMM, CGEMM, XERBLA
*>
*> \verbatim
*>
-*> CGEMQRT overwrites the general real M-by-N matrix C with
+*> CGEMLQT overwrites the general real M-by-N matrix C with
*>
*> SIDE = 'L' SIDE = 'R'
*> TRANS = 'N': Q C C Q
-*> TRANS = 'C': Q**C C C Q**C
+*> TRANS = 'C': Q**H C C Q**H
*>
*> where Q is a complex orthogonal matrix defined as the product of K
*> elementary reflectors:
*>
-*> Q = H(1) H(2) . . . H(K) = I - V C V**C
+*> Q = H(1) H(2) . . . H(K) = I - V T V**H
*>
*> generated using the compact WY representation as returned by CGELQT.
*>
*> \param[in] SIDE
*> \verbatim
*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**C from the Left;
-*> = 'R': apply Q or Q**C from the Right.
+*> = 'L': apply Q or Q**H from the Left;
+*> = 'R': apply Q or Q**H from the Right.
*> \endverbatim
*>
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': No transpose, apply Q;
-*> = 'C': Transpose, apply Q**C.
+*> = 'C': Transpose, apply Q**H.
*> \endverbatim
*>
*> \param[in] M
*>
*> \param[in] V
*> \verbatim
-*> V is COMPLEX array, dimension (LDV,K)
+*> V is COMPLEX array, dimension
+*> (LDV,M) if SIDE = 'L',
+*> (LDV,N) if SIDE = 'R'
*> The i-th row must contain the vector which defines the
*> elementary reflector H(i), for i = 1,2,...,k, as returned by
*> DGELQT in the first K rows of its array argument A.
*> \param[in] LDV
*> \verbatim
*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
+*> The leading dimension of the array V. LDV >= max(1,K).
*> \endverbatim
*>
*> \param[in] T
*> \verbatim
*> T is COMPLEX array, dimension (LDT,K)
*> The upper triangular factors of the block reflectors
-*> as returned by DGELQT, stored as a MB-by-M matrix.
+*> as returned by DGELQT, stored as a MB-by-K matrix.
*> \endverbatim
*>
*> \param[in] LDT
*> \verbatim
*> C is COMPLEX array, dimension (LDC,N)
*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q C, Q**C C, C Q**C or C Q.
+*> On exit, C is overwritten by Q C, Q**H C, C Q**H or C Q.
*> \endverbatim
*>
*> \param[in] LDC
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
SUBROUTINE CGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT,
$ C, LDC, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN
- INTEGER I, IB, LDWORK, KF, Q
+ INTEGER I, IB, LDWORK, KF
* ..
* .. External Functions ..
LOGICAL LSAME
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexGEcomputational
*
*> block is of order NB except for the last block, which is of order
*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
+*> for the last block) T's are stored in the NB-by-K matrix T as
*>
*> T = (T1 T2 ... TB).
*> \endverbatim
* =====================================================================
SUBROUTINE CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDT, M, N, NB
-*> \brief <b> CGESV computes the solution to system of linear equations A * X = B for GE matrices</b> (simple driver) </b>
+*> \brief <b> CGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) </b>
*
* =========== DOCUMENTATION ===========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexGEsolve
*
* =====================================================================
SUBROUTINE CGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, N, NRHS
$ IL, IU, NS, S, U, LDU, VT, LDVT, WORK,
$ LWORK, RWORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Subroutines ..
EXTERNAL CGEBRD, CGELQF, CGEQRF, CLASCL, CLASET,
- $ SLASCL, XERBLA
+ $ CUNMBR, CUNMQR, CUNMLQ, CLACPY,
+ $ SBDSVDX, SLASCL, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
*
*> \param[in] JOBA
*> \verbatim
-*> JOBA is CHARACTER* 1
+*> JOBA is CHARACTER*1
*> Specifies the structure of A.
*> = 'L': The input matrix A is lower triangular;
*> = 'U': The input matrix A is upper triangular;
*>
*> \param[in,out] CWORK
*> \verbatim
-*> CWORK is COMPLEX array, dimension max(1,LWORK).
+*> CWORK is COMPLEX array, dimension (max(1,LWORK))
*> Used as workspace.
*> If on entry LWORK .EQ. -1, then a workspace query is assumed and
*> no computation is done; CWORK(1) is set to the minial (and optimal)
*>
*> \param[in,out] RWORK
*> \verbatim
-*> RWORK is REAL array, dimension max(6,LRWORK).
+*> RWORK is REAL array, dimension (max(6,LRWORK))
*> On entry,
*> If JOBU .EQ. 'C' :
*> RWORK(1) = CTOL, where CTOL defines the threshold for convergence.
*> \par References:
* ================
*>
+*> \verbatim
+*>
*> [1] P. P. M. De Rijk: A one-sided Jacobi algorithm for computing the
*> singular value decomposition on a vector computer.
*> SIAM J. Sci. Stat. Comp., Vol. 10 (1998), pp. 359-371.
SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
$ LDV, CWORK, LWORK, RWORK, LRWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. External Subroutines ..
* ..
* from BLAS
- EXTERNAL CCOPY, CROT, CSSCAL, CSWAP
+ EXTERNAL CCOPY, CROT, CSSCAL, CSWAP, CAXPY
* from LAPACK
EXTERNAL CLASCL, CLASET, CLASSQ, SLASCL, XERBLA
EXTERNAL CGSVJ0, CGSVJ1
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': the linear system involves A;
-*> = 'C': the linear system involves A**C.
+*> = 'C': the linear system involves A**H.
*> \endverbatim
*>
*> \param[in] M
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexGEsolve
*
SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS
INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW,
$ SCLLEN, MNK, TSZO, TSZM, LWO, LWM, LW1, LW2,
$ WSIZEO, WSIZEM, INFO2
- REAL ANRM, BIGNUM, BNRM, SMLNUM
- COMPLEX TQ( 5 ), WORKQ
+ REAL ANRM, BIGNUM, BNRM, SMLNUM, DUM( 1 )
+ COMPLEX TQ( 5 ), WORKQ( 1 )
* ..
* .. External Functions ..
LOGICAL LSAME
IF( M.GE.N ) THEN
CALL CGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
- LWO = INT( WORKQ )
+ LWO = INT( WORKQ( 1 ) )
CALL CGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWO = MAX( LWO, INT( WORKQ ) )
+ LWO = MAX( LWO, INT( WORKQ( 1 ) ) )
CALL CGEQR( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
TSZM = INT( TQ( 1 ) )
- LWM = INT( WORKQ )
+ LWM = INT( WORKQ( 1 ) )
CALL CGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
$ TSZM, B, LDB, WORKQ, -1, INFO2 )
- LWM = MAX( LWM, INT( WORKQ ) )
+ LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
WSIZEO = TSZO + LWO
WSIZEM = TSZM + LWM
ELSE
CALL CGELQ( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
- LWO = INT( WORKQ )
+ LWO = INT( WORKQ( 1 ) )
CALL CGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWO = MAX( LWO, INT( WORKQ ) )
+ LWO = MAX( LWO, INT( WORKQ( 1 ) ) )
CALL CGELQ( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
TSZM = INT( TQ( 1 ) )
- LWM = INT( WORKQ )
+ LWM = INT( WORKQ( 1 ) )
CALL CGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWM = MAX( LWM, INT( WORKQ ) )
+ LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
WSIZEO = TSZO + LWO
WSIZEM = TSZM + LWM
END IF
*
* Scale A, B if max element outside range [SMLNUM,BIGNUM]
*
- ANRM = CLANGE( 'M', M, N, A, LDA, WORK )
+ ANRM = CLANGE( 'M', M, N, A, LDA, DUM )
IASCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
*
IF ( TRAN ) THEN
BROW = N
END IF
- BNRM = CLANGE( 'M', BROW, NRHS, B, LDB, WORK )
+ BNRM = CLANGE( 'M', BROW, NRHS, B, LDB, DUM )
IBSCL = 0
IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
*
*>
*> \param[in] SELCTG
*> \verbatim
-*> SELCTG is procedure) LOGICAL FUNCTION of two COMPLEX arguments
+*> SELCTG is a LOGICAL FUNCTION of two COMPLEX arguments
*> SELCTG must be declared EXTERNAL in the calling subroutine.
*> If SORT = 'N', SELCTG is not referenced.
*> If SORT = 'S', SELCTG is used to select eigenvalues to sort
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexGEeigen
*
$ LDVSR, RCONDE, RCONDV, WORK, LWORK, RWORK,
$ IWORK, LIWORK, BWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SENSE, SORT
SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
$ LDQ, Z, LDZ, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.6.1) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2015
EXTERNAL ILAENV, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL CGGHRD, CLARTG, CLASET, CUNM22, CROT, XERBLA
+ EXTERNAL CGGHRD, CLARTG, CLASET, CUNM22, CROT, CGEMM,
+ $ CGEMV, CTRMV, CLACPY, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC REAL, CMPLX, CONJG, MAX
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension LWORK.
+*> WORK is COMPLEX array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS,
$ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. External Subroutines ..
* ..
* from BLAS
- EXTERNAL CCOPY, CROT, CSWAP
+ EXTERNAL CCOPY, CROT, CSWAP, CAXPY
* from LAPACK
EXTERNAL CLASCL, CLASSQ, XERBLA
* ..
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension LWORK.
+*> WORK is COMPLEX array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
SUBROUTINE CGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
$ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Subroutines ..
* .. from BLAS
- EXTERNAL CCOPY, CROT, CSWAP
+ EXTERNAL CCOPY, CROT, CSWAP, CAXPY
* .. from LAPACK
EXTERNAL CLASCL, CLASSQ, XERBLA
* ..
* Arguments:
* ==========
*
-*> @param[in] n
-*> The order of the matrix A.
-*>
-*> @param[in] nb
-*> The size of the band.
-*>
-*> @param[in, out] A
-*> A pointer to the matrix A.
-*>
-*> @param[in] lda
-*> The leading dimension of the matrix A.
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> \endverbatim
*>
-*> @param[out] V
-*> COMPLEX array, dimension 2*n if eigenvalues only are
-*> requested or to be queried for vectors.
+*> \param[in] WANTZ
+*> \verbatim
+*> WANTZ is LOGICAL which indicate if Eigenvalue are requested or both
+*> Eigenvalue/Eigenvectors.
+*> \endverbatim
*>
-*> @param[out] TAU
-*> COMPLEX array, dimension (2*n).
-*> The scalar factors of the Householder reflectors are stored
-*> in this array.
+*> \param[in] TTYPE
+*> \verbatim
+*> TTYPE is INTEGER
+*> \endverbatim
*>
-*> @param[in] st
+*> \param[in] ST
+*> \verbatim
+*> ST is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] ed
+*> \param[in] ED
+*> \verbatim
+*> ED is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] sweep
+*> \param[in] SWEEP
+*> \verbatim
+*> SWEEP is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] Vblksiz
-*> internal parameter for indices.
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER. The order of the matrix A.
+*> \endverbatim
*>
-*> @param[in] wantz
-*> logical which indicate if Eigenvalue are requested or both
-*> Eigenvalue/Eigenvectors.
+*> \param[in] NB
+*> \verbatim
+*> NB is INTEGER. The size of the band.
+*> \endverbatim
+*>
+*> \param[in] IB
+*> \verbatim
+*> IB is INTEGER.
+*> \endverbatim
+*>
+*> \param[in, out] A
+*> \verbatim
+*> A is COMPLEX array. A pointer to the matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER. The leading dimension of the matrix A.
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*> V is COMPLEX array, dimension 2*n if eigenvalues only are
+*> requested or to be queried for vectors.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX array, dimension (2*n).
+*> The scalar factors of the Householder reflectors are stored
+*> in this array.
+*> \endverbatim
+*>
+*> \param[in] LDVT
+*> \verbatim
+*> LDVT is INTEGER.
+*> \endverbatim
*>
-*> @param[in] work
-*> Workspace of size nb.
+*> \param[in] WORK
+*> \verbatim
+*> WORK is COMPLEX array. Workspace of size nb.
+*> \endverbatim
*>
*> \par Further Details:
* =====================
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexOTHEReigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, CLANHB
- EXTERNAL LSAME, SLAMCH, CLANHB, ILAENV
+ EXTERNAL LSAME, SLAMCH, CLANHB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SSCAL, SSTERF, XERBLA, CLASCL, CSTEQR,
- $ CHETRD_2STAGE
+ $ CHETRD_2STAGE, CHETRD_HB2ST
* ..
* .. Intrinsic Functions ..
INTRINSIC REAL, SQRT
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- IB = ILAENV( 18, 'CHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'CHETRD_HB2ST', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'CHETRD_HB2ST', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = LHTRD + LWTRD
WORK( 1 ) = LWMIN
ENDIF
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexOTHEReigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, CLANHB
- EXTERNAL LSAME, SLAMCH, CLANHB, ILAENV
+ EXTERNAL LSAME, SLAMCH, CLANHB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SSCAL, SSTERF, XERBLA, CGEMM, CLACPY,
LRWMIN = 1
LIWMIN = 1
ELSE
- IB = ILAENV( 18, 'CHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
IF( WANTZ ) THEN
LWMIN = 2*N**2
LRWMIN = 1 + 5*N + 2*N**2
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, CLANHB
- EXTERNAL LSAME, SLAMCH, CLANHB, ILAENV
+ EXTERNAL LSAME, SLAMCH, CLANHB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CCOPY,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- IB = ILAENV( 18, 'CHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'CHETRD_HB2ST', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'CHETRD_HB2ST', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = LHTRD + LWTRD
WORK( 1 ) = LWMIN
ENDIF
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexHEcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE CHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
$ WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* =====================================================================
SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
EXTERNAL LSAME, SLAMCH
* ..
* .. External Subroutines ..
- EXTERNAL CLASSQ
+ EXTERNAL CLASSQ, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, AIMAG, INT, LOG, MAX, MIN, REAL, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, CLANHE
- EXTERNAL LSAME, ILAENV, SLAMCH, CLANHE
+ EXTERNAL LSAME, SLAMCH, CLANHE, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SSCAL, SSTERF, XERBLA, CLASCL, CSTEQR,
END IF
*
IF( INFO.EQ.0 ) THEN
- KD = ILAENV( 17, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, CLANHE
- EXTERNAL LSAME, ILAENV, SLAMCH, CLANHE
+ EXTERNAL LSAME, SLAMCH, CLANHE, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SSCAL, SSTERF, XERBLA, CLACPY, CLASCL,
LRWMIN = 1
LIWMIN = 1
ELSE
- KD = ILAENV( 17, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ,
+ $ N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
IF( WANTZ ) THEN
LWMIN = 2*N + N*N
LRWMIN = 1 + 5*N + 2*N**2
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV, ILAENV2STAGE
REAL SLAMCH, CLANSY
- EXTERNAL LSAME, ILAENV, SLAMCH, CLANSY
+ EXTERNAL LSAME, SLAMCH, CLANSY, ILAENV, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL,
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR.
$ ( LIWORK.EQ.-1 ) )
*
- KD = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
LRWMIN = MAX( 1, 24*N )
LIWMIN = MAX( 1, 10*N )
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, CLANHE
- EXTERNAL LSAME, ILAENV, SLAMCH, CLANHE
+ EXTERNAL LSAME, SLAMCH, CLANHE, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- KD = ILAENV( 17, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ,
+ $ N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
END IF
*> positive definite.
*> This routine use the 2stage technique for the reduction to tridiagonal
*> which showed higher performance on recent architecture and for large
-* sizes N>2000.
+*> sizes N>2000.
*> \endverbatim
*
* Arguments:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ INTEGER ILAENV2STAGE
+ EXTERNAL LSAME, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, CHEGST, CPOTRF, CTRMM, CTRSM,
END IF
*
IF( INFO.EQ.0 ) THEN
- KD = ILAENV( 17, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
*
*> The length of WORK. LWORK >= MAX(1,2*N,3*N-2), and for best
*> performance LWORK >= MAX(1,N*NB), where NB is the optimal
*> blocksize for CHETRF.
-*> for LWORK < N, TRS will be done with Level BLAS 2
-*> for LWORK >= N, TRS will be done with Level BLAS 3
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEsolve
*
SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, CHETRF, CHETRS, CHETRS2
+ EXTERNAL XERBLA, CHETRF_AA, CHETRS_AA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief <b> CHESV_AA_2STAGE computes the solution to system of linear equations A * X = B for HE matrices</b>
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHESV_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chesv_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chesv_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chesv_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+* IPIV, IPIV2, B, LDB, WORK, LWORK,
+* INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX A( LDA, * ), TB( * ), B( LDB, *), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CHESV_AA_2STAGE computes the solution to a complex system of
+*> linear equations
+*> A * X = B,
+*> where A is an N-by-N Hermitian matrix and X and B are N-by-NRHS
+*> matrices.
+*>
+*> Aasen's 2-stage algorithm is used to factor A as
+*> A = U * T * U**H, if UPLO = 'U', or
+*> A = L * T * L**H, if UPLO = 'L',
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is Hermitian and band. The matrix T is
+*> then LU-factored with partial pivoting. The factored form of A
+*> is then used to solve the system of equations A * X = B.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> On entry, the hermitian matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complexSYcomputational
+*
+* =====================================================================
+ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, WORK, LWORK,
+ $ INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LDB, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX A( LDA, * ), B( LDB, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER LWKOPT
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL CHETRF_AA_2STAGE, CHETRS_AA_2STAGE,
+ $ XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
+ $ IPIV2, WORK, -1, INFO )
+ LWKOPT = INT( WORK(1) )
+ IF( LTB.LT.INT( TB(1) ) .AND. .NOT.TQUERY ) THEN
+ INFO = -7
+ ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.WQUERY ) THEN
+ INFO = -13
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'CHESV_AA_2STAGE', -INFO )
+ RETURN
+ ELSE IF( WQUERY .OR. TQUERY ) THEN
+ RETURN
+ END IF
+*
+*
+* Compute the factorization A = U*T*U**H or A = L*T*L**H.
+*
+ CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
+ $ WORK, LWORK, INFO )
+ IF( INFO.EQ.0 ) THEN
+*
+* Solve the system A*X = B, overwriting B with X.
+*
+ CALL CHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, B, LDB, INFO )
+*
+ END IF
+*
+ WORK( 1 ) = LWKOPT
+*
+* End of CHESV_AA_2STAGE
+*
+ END
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension LWORK.
+*> WORK is COMPLEX array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEcomputational
*
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER VECT, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ INTEGER ILAENV2STAGE
+ EXTERNAL LSAME, ILAENV2STAGE
* ..
* .. Executable Statements ..
*
*
* Determine the block size, the workspace size and the hous size.
*
- KD = ILAENV( 17, 'CHETRD_2STAGE', VECT, N, -1, -1, -1 )
- IB = ILAENV( 18, 'CHETRD_2STAGE', VECT, N, KD, -1, -1 )
- LHMIN = ILAENV( 19, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 )
- LWMIN = ILAENV( 20, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', VECT, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', VECT, N, KD, -1, -1 )
+ LHMIN = ILAENV2STAGE( 3, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 )
+ LWMIN = ILAENV2STAGE( 4, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 )
* WRITE(*,*),'CHETRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
* $ LHMIN, LWMIN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexOTHERcomputational
*
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER STAGE1, UPLO, VECT
COMPLEX TMP
* ..
* .. External Subroutines ..
- EXTERNAL CHB2ST_KERNELS, CLACPY, CLASET
+ EXTERNAL CHB2ST_KERNELS, CLACPY, CLASET, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MIN, MAX, CEILING, REAL
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension LWORK.
+*> WORK is COMPLEX array, dimension (LWORK)
*> On exit, if INFO = 0, or if LWORK=-1,
*> WORK(1) returns the size of LWORK.
*> \endverbatim
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK which should be calculated
-* by a workspace query. LWORK = MAX(1, LWORK_QUERY)
+*> by a workspace query. LWORK = MAX(1, LWORK_QUERY)
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEcomputational
*
*>
*> where tau is a complex scalar, and v is a complex vector with
*> v(kd+1:i) = 0 and v(i+kd+1) = 1; v(i+kd+2:n) is stored on exit in
-* A(i+kd+2:n,i), and tau in TAU(i).
+*> A(i+kd+2:n,i), and tau in TAU(i).
*>
*> The contents of A on exit are illustrated by the following examples
*> with n = 5:
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
$ TPOS, WPOS, S2POS, S1POS
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, CHER2K, CHEMM, CGEMM,
+ EXTERNAL XERBLA, CHER2K, CHEMM, CGEMM, CCOPY,
$ CLARFT, CGELQF, CGEQRF, CLASET
* ..
* .. Intrinsic Functions ..
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEcomputational
*
* =====================================================================
SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
*
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
- INTEGER J, LWKOPT, IINFO
+ INTEGER J, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
COMPLEX ALPHA
* ..
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL CLAHEF_AA, CGEMM, CCOPY, CSWAP, CSCAL, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC REAL, CONJG, MAX
*
* Determine the block size
*
- NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 )
+ NB = ILAENV( 1, 'CHETRF_AA', UPLO, N, -1, -1, -1 )
*
* Test the input parameters.
*
IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN
A( 1, 1 ) = REAL( A( 1, 1 ) )
- IF ( A( 1, 1 ).EQ.ZERO ) THEN
- INFO = 1
- END IF
RETURN
END IF
*
-* Adjubst block size based on the workspace size
+* Adjust block size based on the workspace size
*
IF( LWORK.LT.((1+NB)*N) ) THEN
NB = ( LWORK-N ) / N
*
CALL CLAHEF_AA( UPLO, 2-K1, N-J, JB,
$ A( MAX(1, J), J+1 ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
- $ IINFO )
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
*
CALL CLAHEF_AA( UPLO, 2-K1, N-J, JB,
$ A( J+1, MAX(1, J) ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
--- /dev/null
+*> \brief \b CHETRF_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHETRF_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrf_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrf_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrf_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+* IPIV2, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CHETRF_AA_2STAGE computes the factorization of a real hermitian matrix A
+*> using the Aasen's algorithm. The form of the factorization is
+*>
+*> A = U*T*U**T or A = L*T*L**T
+*>
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is a hermitian band matrix with the
+*> bandwidth of NB (NB is internally selected and stored in TB( 1 ), and T is
+*> LU factorized with partial pivoting).
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> On entry, the hermitian matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complexSYcomputational
+*
+* =====================================================================
+ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, WORK, LWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+* .. Parameters ..
+ COMPLEX ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ),
+ $ ONE = ( 1.0E+0, 0.0E+0 ) )
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER I, J, K, I1, I2, TD
+ INTEGER LDTB, NB, KB, JB, NT, IINFO
+ COMPLEX PIV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, CCOPY, CLACGV, CLACPY,
+ $ CLASET, CGBTRF, CGEMM, CGETRF,
+ $ CHEGST, CSWAP, CTRSM
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CONJG, MIN, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN
+ INFO = -6
+ ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN
+ INFO = -10
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'CHETRF_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Answer the query
+*
+ NB = ILAENV( 1, 'CHETRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
+ IF( INFO.EQ.0 ) THEN
+ IF( TQUERY ) THEN
+ TB( 1 ) = (3*NB+1)*N
+ END IF
+ IF( WQUERY ) THEN
+ WORK( 1 ) = N*NB
+ END IF
+ END IF
+ IF( TQUERY .OR. WQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return
+*
+ IF ( N.EQ.0 ) THEN
+ RETURN
+ ENDIF
+*
+* Determine the number of the block size
+*
+ LDTB = LTB/N
+ IF( LDTB .LT. 3*NB+1 ) THEN
+ NB = (LDTB-1)/3
+ END IF
+ IF( LWORK .LT. NB*N ) THEN
+ NB = LWORK/N
+ END IF
+*
+* Determine the number of the block columns
+*
+ NT = (N+NB-1)/NB
+ TD = 2*NB
+ KB = MIN(NB, N)
+*
+* Initialize vectors/matrices
+*
+ DO J = 1, KB
+ IPIV( J ) = J
+ END DO
+*
+* Save NB
+*
+ TB( 1 ) = NB
+*
+ IF( UPPER ) THEN
+*
+* .....................................................
+* Factorize A as L*D*L**T using the upper triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*U(I,J) + T(I+1,I)*U(I+1,J)
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( (I-1)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*U(I-1,J) + T(I,I)*U(I,J) + T(I,I+1)*U(I+1,J)
+ IF( I .EQ. (J-1) ) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (I-2)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL CLACPY( 'Upper', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = U(1:J,J)'*H(1:J)
+ CALL CGEMM( 'Conjugate transpose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -ONE, A( 1, J*NB+1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += U(J,J)'*T(J,J-1)*U(J-1,J)
+ CALL CGEMM( 'Conjugate transpose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ ONE, A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ ZERO, WORK( 1 ), N )
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB,
+ $ -ONE, WORK( 1 ), N,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+ IF( J.GT.0 ) THEN
+ CALL CHEGST( 1, 'Upper', KB,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA, IINFO )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ TB( TD+1 + (J*NB+I-1)*LDTB )
+ $ = REAL( TB( TD+1 + (J*NB+I-1)*LDTB ) )
+ DO K = I+1, KB
+ TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ $ = CONJG( TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB ) )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, KB,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB+KB,
+ $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL CGEMM( 'Conjugate transpose', 'NoTranspose',
+ $ NB, N-(J+1)*NB, J*NB,
+ $ -ONE, WORK( NB+1 ), N,
+ $ A( 1, (J+1)*NB+1 ), LDA,
+ $ ONE, A( J*NB+1, (J+1)*NB+1 ), LDA )
+ END IF
+*
+* Copy panel to workspace to call CGETRF
+*
+ DO K = 1, NB
+ CALL CCOPY( N-(J+1)*NB,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA,
+ $ WORK( 1+(K-1)*N ), 1 )
+ END DO
+*
+* Factorize panel
+*
+ CALL CGETRF( N-(J+1)*NB, NB,
+ $ WORK, N,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Copy panel back
+*
+ DO K = 1, NB
+*
+* Copy only L-factor
+*
+ CALL CCOPY( N-K-(J+1)*NB,
+ $ WORK( K+1+(K-1)*N ), 1,
+ $ A( J*NB+K, (J+1)*NB+K+1 ), LDA )
+*
+* Transpose U-factor to be copied back into T(J+1, J)
+*
+ CALL CLACGV( K, WORK( 1+(K-1)*N ), 1 )
+ END DO
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL CLASET( 'Full', KB, NB, ZERO, ZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL CLACPY( 'Upper', KB, NB,
+ $ WORK, N,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL CTRSM( 'R', 'U', 'N', 'U', KB, NB, ONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J,J+1) into T(J+1, J), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB )
+ $ = CONJG( TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB ) )
+ END DO
+ END DO
+ CALL CLASET( 'Lower', KB, NB, ZERO, ONE,
+ $ A( J*NB+1, (J+1)*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL CSWAP( K-1, A( (J+1)*NB+1, I1 ), 1,
+ $ A( (J+1)*NB+1, I2 ), 1 )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL CSWAP( I2-I1-1, A( I1, I1+1 ), LDA,
+ $ A( I1+1, I2 ), 1 )
+ CALL CLACGV( I2-I1, A( I1, I1+1 ), LDA )
+ CALL CLACGV( I2-I1-1, A( I1+1, I2 ), 1 )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL CSWAP( N-I2, A( I1, I2+1 ), LDA,
+ $ A( I2, I2+1 ), LDA )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL CSWAP( J*NB, A( 1, I1 ), 1,
+ $ A( 1, I2 ), 1 )
+ END IF
+ ENDIF
+ END DO
+ END IF
+ END DO
+ ELSE
+*
+* .....................................................
+* Factorize A as L*D*L**T using the lower triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*L(J,I)' + T(I+1,I)'*L(J,I+1)'
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL CGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (I-1)*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*L(J,I-1)' + T(I,I)*L(J,I)' + T(I,I+1)*L(J,I+1)'
+ IF( I .EQ. (J-1) ) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL CGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (I-2)*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL CLACPY( 'Lower', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = L(J,1:J)*H(1:J)
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -ONE, A( J*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += L(J,J)*T(J,J-1)*L(J,J-1)'
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ ONE, A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ ZERO, WORK( 1 ), N )
+ CALL CGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ KB, KB, NB,
+ $ -ONE, WORK( 1 ), N,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+ IF( J.GT.0 ) THEN
+ CALL CHEGST( 1, 'Lower', KB,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA, IINFO )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ TB( TD+1 + (J*NB+I-1)*LDTB )
+ $ = REAL( TB( TD+1 + (J*NB+I-1)*LDTB ) )
+ DO K = I+1, KB
+ TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ $ = CONJG( TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB ) )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL CGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ KB, KB, KB,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL CGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ KB, KB, NB+KB,
+ $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ N-(J+1)*NB, NB, J*NB,
+ $ -ONE, A( (J+1)*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, A( (J+1)*NB+1, J*NB+1 ), LDA )
+ END IF
+*
+* Factorize panel
+*
+ CALL CGETRF( N-(J+1)*NB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL CLASET( 'Full', KB, NB, ZERO, ZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL CLACPY( 'Upper', KB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL CTRSM( 'R', 'L', 'C', 'U', KB, NB, ONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J+1,J) into T(J, J+1), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB )
+ $ = CONJG( TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB ) )
+ END DO
+ END DO
+ CALL CLASET( 'Upper', KB, NB, ZERO, ONE,
+ $ A( (J+1)*NB+1, J*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL CSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA,
+ $ A( I2, (J+1)*NB+1 ), LDA )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL CSWAP( I2-I1-1, A( I1+1, I1 ), 1,
+ $ A( I2, I1+1 ), LDA )
+ CALL CLACGV( I2-I1, A( I1+1, I1 ), 1 )
+ CALL CLACGV( I2-I1-1, A( I2, I1+1 ), LDA )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL CSWAP( N-I2, A( I2+1, I1 ), 1,
+ $ A( I2+1, I2 ), 1 )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL CSWAP( J*NB, A( I1, 1 ), LDA,
+ $ A( I2, 1 ), LDA )
+ END IF
+ ENDIF
+ END DO
+*
+* Apply pivots to previous columns of L
+*
+c CALL CLASWP( J*NB, A( 1, 1 ), LDA,
+c $ (J+1)*NB+1, (J+1)*NB+KB, IPIV, 1 )
+ END IF
+ END DO
+ END IF
+*
+* Factor the band matrix
+ CALL CGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO )
+*
+* End of CHETRF_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEcomputational
*
* =====================================================================
SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL CHETRI2X
+ EXTERNAL CHETRI2X, CHETRI, XERBLA
* ..
* .. Executable Statements ..
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE CHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL CHETRI_3X
+ EXTERNAL CHETRI_3X, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexHEcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexHEcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> of the matrix B. NRHS >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is COMPLEX array, dimension (LDA,N)
*> Details of factors computed by CHETRF_AA.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexHEcomputational
*
SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL CGTSV, CSWAP, CTRSM, XERBLA
+ EXTERNAL CLACPY, CLACGV, CGTSV, CSWAP, CTRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief \b CHETRS_AA_2STAGE
+*
+* @generated from SRC/dsytrs_aa_2stage.f, fortran d -> c, Mon Oct 30 11:59:02 2017
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CHETRS_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrs_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrs_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrs_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+* IPIV2, B, LDB, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CHETRS_AA_2STAGE solves a system of linear equations A*X = B with a real
+*> hermitian matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by CHETRF_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the details of the factorization are stored
+*> as an upper or lower triangular matrix.
+*> = 'U': Upper triangular, form is A = U*T*U**T;
+*> = 'L': Lower triangular, form is A = L*T*L**T.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> Details of factors computed by CHETRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX array, dimension (LTB)
+*> Details of factors computed by CHETRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> CHETRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] IPIV2
+*> \verbatim
+*> IPIV2 is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> CHETRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complexSYcomputational
+*
+* =====================================================================
+ SUBROUTINE CHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+* =====================================================================
+*
+ COMPLEX ONE
+ PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER LDTB, NB
+ LOGICAL UPPER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL CGBTRS, CLASWP, CTRSM, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LTB.LT.( 4*N ) ) THEN
+ INFO = -7
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'CHETRS_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. NRHS.EQ.0 )
+ $ RETURN
+*
+* Read NB and compute LDTB
+*
+ NB = INT( TB( 1 ) )
+ LDTB = LTB/N
+*
+ IF( UPPER ) THEN
+*
+* Solve A*X = B, where A = U*T*U**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ]
+*
+ CALL CTRSM( 'L', 'U', 'C', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (U**T \P**T * B) ]
+*
+ CALL CGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ]
+*
+ CALL CTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ]
+*
+ CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+*
+ ELSE
+*
+* Solve A*X = B, where A = L*T*L**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
+*
+ CALL CTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (L \P**T * B) ]
+*
+ CALL CGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
+*
+ CALL CTRSM( 'L', 'L', 'C', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
+*
+ CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of CHETRS_AA_2STAGE
+*
+ END
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexGBcomputational
*
$ Y_TAIL, RCOND, ITHRESH, RTHRESH,
$ DZ_UB, IGNORE_CWISE, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDAB, LDAFB, LDB, LDY, N, KL, KU, NRHS,
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, n ).
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexHEcomputational
*
SUBROUTINE CLA_HEAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
$ INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
REAL ALPHA, BETA
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX array, dimension
-*> (LDY,NRHS)
+*> Y is COMPLEX array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by CHETRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexHEcomputational
*
$ RTHRESH, DZ_UB, IGNORE_CWISE,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX array, dimension
-*> (LDY,NRHS)
+*> Y is COMPLEX array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by CPOTRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexPOcomputational
*
$ RTHRESH, DZ_UB, IGNORE_CWISE,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX array of DIMENSION ( LDA, n ).
+*> A is COMPLEX array, dimension ( LDA, n ).
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexSYcomputational
*
SUBROUTINE CLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
$ INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
REAL ALPHA, BETA
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX array, dimension
-*> (LDY,NRHS)
+*> Y is COMPLEX array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by CSYTRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexSYcomputational
*
$ RTHRESH, DZ_UB, IGNORE_CWISE,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is COMPLEX array dimension (NB)
+*> TAUQ is COMPLEX array, dimension (NB)
*> The scalar factors of the elementary reflectors which
*> represent the unitary matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexOTHERauxiliary
*
SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
$ LDY )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, LDX, LDY, M, N, NB
* ===========
*
* SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-* H, LDH, WORK, INFO )
+* H, LDH, WORK )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
-* INTEGER J1, M, NB, LDA, LDH, INFO
+* INTEGER J1, M, NB, LDA, LDH
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
*> WORK is COMPLEX workspace, dimension (M).
*> \endverbatim
*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
*
* Authors:
* ========
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYcomputational
*
* =====================================================================
SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
- $ H, LDH, WORK, INFO )
+ $ H, LDH, WORK )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
* .. Scalar Arguments ..
CHARACTER UPLO
- INTEGER M, NB, J1, LDA, LDH, INFO
+ INTEGER M, NB, J1, LDA, LDH
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
PARAMETER ( ZERO = (0.0E+0, 0.0E+0), ONE = (1.0E+0, 0.0E+0) )
*
* .. Local Scalars ..
- INTEGER J, K, K1, I1, I2
+ INTEGER J, K, K1, I1, I2, MJ
COMPLEX PIV, ALPHA
* ..
* .. External Functions ..
EXTERNAL LSAME, ILAENV, ICAMAX
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL CLACGV, CGEMV, CSCAL, CAXPY, CCOPY, CSWAP, CLASET,
+ $ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC REAL, CONJG, MAX
* ..
* .. Executable Statements ..
*
- INFO = 0
J = 1
*
* K1 is the first column of the panel to be factorized
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
* H(J:N, J) := A(J, J:N) - H(J:N, 1:(J-1)) * L(J1:(J-1), J),
* where H(J:N, J) has been initialized to be A(J, J:N)
* first column
*
CALL CLACGV( J-K1, A( 1, J ), 1 )
- CALL CGEMV( 'No transpose', M-J+1, J-K1,
+ CALL CGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( 1, J ), 1,
$ ONE, H( J, J ), 1 )
*
* Copy H(i:n, i) into WORK
*
- CALL CCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL CCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
* where A(J-1, J) stores T(J-1, J) and A(J-2, J:N) stores U(J-1, J:N)
*
ALPHA = -CONJG( A( K-1, J ) )
- CALL CAXPY( M-J+1, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
+ CALL CAXPY( MJ, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
* Set A(J, J+1) = T(J, J+1)
*
A( K, J+1 ) = WORK( 2 )
- IF( (A( K, J ).EQ.ZERO ) .AND.
- $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
- IF(INFO .EQ. 0) THEN
- INFO = J
- END IF
- END IF
*
IF( J.LT.NB ) THEN
*
CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO,
$ A( K, J+2 ), LDA)
END IF
- ELSE
- IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 10
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
* H(J:N, J) := A(J:N, J) - H(J:N, 1:(J-1)) * L(J, J1:(J-1))^T,
* where H(J:N, J) has been initialized to be A(J:N, J)
* first column
*
CALL CLACGV( J-K1, A( J, 1 ), LDA )
- CALL CGEMV( 'No transpose', M-J+1, J-K1,
+ CALL CGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( J, 1 ), LDA,
$ ONE, H( J, J ), 1 )
*
* Copy H(J:N, J) into WORK
*
- CALL CCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL CCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
* where A(J-1, J) = T(J-1, J) and A(J, J-2) = L(J, J-1)
*
ALPHA = -CONJG( A( J, K-1 ) )
- CALL CAXPY( M-J+1, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
+ CALL CAXPY( MJ, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
* Set A(J+1, J) = T(J+1, J)
*
A( J+1, K ) = WORK( 2 )
- IF( (A( J, K ).EQ.ZERO) .AND.
- $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
- IF (INFO .EQ. 0)
- $ INFO = J
- END IF
*
IF( J.LT.NB ) THEN
*
CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO,
$ A( J+2, K ), LDA )
END IF
- ELSE
- IF( (A( J, K ).EQ.ZERO) .AND. (J.EQ.M)
- $ .AND. (INFO.EQ.0) ) INFO = J
END IF
J = J + 1
GO TO 30
*>
*> \param[out] IWORK
*> \verbatim
-*> IWORK is INTEGER array.
-*> The dimension must be at least 3 * N
+*> IWORK is INTEGER array, dimension (3*N)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexOTHERcomputational
*
$ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, RWORK,
$ IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
*>
*> SIDE = 'L' SIDE = 'R'
*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
+*> TRANS = 'T': Q**H * C C * Q**H
*> where Q is a real orthogonal matrix defined as the product of blocked
*> elementary reflectors computed by short wide LQ
*> factorization (CLASWLQ)
*> \param[in] SIDE
*> \verbatim
*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
+*> = 'L': apply Q or Q**H from the Left;
+*> = 'R': apply Q or Q**H from the Right.
*> \endverbatim
*>
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
+*> = 'C': Transpose, apply Q**H.
*> \endverbatim
*>
*> \param[in] M
*> \verbatim
*> M is INTEGER
-*> The number of rows of the matrix A. M >=0.
+*> The number of rows of the matrix C. M >=0.
*> \endverbatim
*>
*> \param[in] N
*>
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
-*> A is COMPLEX array, dimension (LDA,K)
+*> A is COMPLEX array, dimension
+*> (LDA,M) if SIDE = 'L',
+*> (LDA,N) if SIDE = 'R'
*> The i-th row must contain the vector which defines the blocked
*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DLASWLQ in the first k rows of its array argument A.
+*> CLASWLQ in the first k rows of its array argument A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> C is COMPLEX array, dimension (LDC,N)
*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
*> \endverbatim
*>
*> \param[in] LDC
SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
- INTEGER I, II, KK, LW , CTR
+ INTEGER I, II, KK, LW, CTR
* ..
* .. External Functions ..
LOGICAL LSAME
*>
*> SIDE = 'L' SIDE = 'R'
*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'C': Q**C * C C * Q**C
+*> TRANS = 'C': Q**H * C C * Q**H
*> where Q is a real orthogonal matrix defined as the product
*> of blocked elementary reflectors computed by tall skinny
*> QR factorization (CLATSQR)
*> \param[in] SIDE
*> \verbatim
*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
+*> = 'L': apply Q or Q**H from the Left;
+*> = 'R': apply Q or Q**H from the Right.
*> \endverbatim
*>
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': No transpose, apply Q;
-*> = 'C': Conjugate Transpose, apply Q**C.
+*> = 'C': Conjugate Transpose, apply Q**H.
*> \endverbatim
*>
*> \param[in] M
*> N >= NB >= 1.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is COMPLEX array, dimension (LDA,K)
*> The i-th column must contain the vector which defines the
*> \verbatim
*> C is COMPLEX array, dimension (LDC,N)
*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
*> \endverbatim
*>
*> \param[in] LDC
SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
*
*> \param[in] N
*> \verbatim
-*> N is integer
+*> N is INTEGER
*> Order of the matrix H. N must be either 2 or 3.
*> \endverbatim
*>
*> \param[in] H
*> \verbatim
-*> H is COMPLEX array of dimension (LDH,N)
+*> H is COMPLEX array, dimension (LDH,N)
*> The 2-by-2 or 3-by-3 matrix H in (*).
*> \endverbatim
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> The leading dimension of H as declared in
*> the calling procedure. LDH.GE.N
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
-*> V is COMPLEX array of dimension N
+*> V is COMPLEX array, dimension (N)
*> A scalar multiple of the first column of the
*> matrix K in (*).
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexOTHERauxiliary
*
* =====================================================================
SUBROUTINE CLAQR1( N, H, LDH, S1, S2, V )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
COMPLEX S1, S2
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> Leading dimension of H just as declared in the calling
*> subroutine. N .LE. LDH
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer
+*> LDZ is INTEGER
*> The leading dimension of Z just as declared in the
*> calling subroutine. 1 .LE. LDZ.
*> \endverbatim
*>
*> \param[out] NS
*> \verbatim
-*> NS is integer
+*> NS is INTEGER
*> The number of unconverged (ie approximate) eigenvalues
*> returned in SR and SI that may be used as shifts by the
*> calling subroutine.
*>
*> \param[out] ND
*> \verbatim
-*> ND is integer
+*> ND is INTEGER
*> The number of converged eigenvalues uncovered by this
*> subroutine.
*> \endverbatim
*>
*> \param[out] SH
*> \verbatim
-*> SH is COMPLEX array, dimension KBOT
+*> SH is COMPLEX array, dimension (KBOT)
*> On output, approximate eigenvalues that may
*> be used for shifts are stored in SH(KBOT-ND-NS+1)
*> through SR(KBOT-ND). Converged eigenvalues are
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> The leading dimension of V just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> The number of columns of T. NH.GE.NW.
*> \endverbatim
*>
*>
*> \param[in] LDT
*> \verbatim
-*> LDT is integer
+*> LDT is INTEGER
*> The leading dimension of T just as declared in the
*> calling subroutine. NW .LE. LDT
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer
+*> NV is INTEGER
*> The number of rows of work array WV available for
*> workspace. NV.GE.NW.
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer
+*> LDWV is INTEGER
*> The leading dimension of W just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension LWORK.
+*> WORK is COMPLEX array, dimension (LWORK)
*> On exit, WORK(1) is set to an estimate of the optimal value
*> of LWORK for the given values of N, NW, KTOP and KBOT.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
-*> LWORK is integer
+*> LWORK is INTEGER
*> The dimension of the work array WORK. LWORK = 2*NW
*> suffices, but greater efficiency may result from larger
*> values of LWORK.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexOTHERauxiliary
*
$ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
$ NV, WV, LDWV, WORK, LWORK )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> Leading dimension of H just as declared in the calling
*> subroutine. N .LE. LDH
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer
+*> LDZ is INTEGER
*> The leading dimension of Z just as declared in the
*> calling subroutine. 1 .LE. LDZ.
*> \endverbatim
*>
*> \param[out] NS
*> \verbatim
-*> NS is integer
+*> NS is INTEGER
*> The number of unconverged (ie approximate) eigenvalues
*> returned in SR and SI that may be used as shifts by the
*> calling subroutine.
*>
*> \param[out] ND
*> \verbatim
-*> ND is integer
+*> ND is INTEGER
*> The number of converged eigenvalues uncovered by this
*> subroutine.
*> \endverbatim
*>
*> \param[out] SH
*> \verbatim
-*> SH is COMPLEX array, dimension KBOT
+*> SH is COMPLEX array, dimension (KBOT)
*> On output, approximate eigenvalues that may
*> be used for shifts are stored in SH(KBOT-ND-NS+1)
*> through SR(KBOT-ND). Converged eigenvalues are
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> The leading dimension of V just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> The number of columns of T. NH.GE.NW.
*> \endverbatim
*>
*>
*> \param[in] LDT
*> \verbatim
-*> LDT is integer
+*> LDT is INTEGER
*> The leading dimension of T just as declared in the
*> calling subroutine. NW .LE. LDT
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer
+*> NV is INTEGER
*> The number of rows of work array WV available for
*> workspace. NV.GE.NW.
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer
+*> LDWV is INTEGER
*> The leading dimension of W just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension LWORK.
+*> WORK is COMPLEX array, dimension (LWORK)
*> On exit, WORK(1) is set to an estimate of the optimal value
*> of LWORK for the given values of N, NW, KTOP and KBOT.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
-*> LWORK is integer
+*> LWORK is INTEGER
*> The dimension of the work array WORK. LWORK = 2*NW
*> suffices, but greater efficiency may result from larger
*> values of LWORK.
$ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
$ NV, WV, LDWV, WORK, LWORK )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[out] INFO
*> \verbatim
-*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
*> .GT. 0: if INFO = i, CLAQR4 failed to compute all of
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexOTHERauxiliary
*
SUBROUTINE CLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ,
$ IHIZ, Z, LDZ, WORK, LWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, LWORK, N
*
*> \param[in] WANTT
*> \verbatim
-*> WANTT is logical scalar
+*> WANTT is LOGICAL
*> WANTT = .true. if the triangular Schur factor
*> is being computed. WANTT is set to .false. otherwise.
*> \endverbatim
*>
*> \param[in] WANTZ
*> \verbatim
-*> WANTZ is logical scalar
+*> WANTZ is LOGICAL
*> WANTZ = .true. if the unitary Schur factor is being
*> computed. WANTZ is set to .false. otherwise.
*> \endverbatim
*>
*> \param[in] KACC22
*> \verbatim
-*> KACC22 is integer with value 0, 1, or 2.
+*> KACC22 is INTEGER with value 0, 1, or 2.
*> Specifies the computation mode of far-from-diagonal
*> orthogonal updates.
*> = 0: CLAQR5 does not accumulate reflections and does not
*>
*> \param[in] N
*> \verbatim
-*> N is integer scalar
+*> N is INTEGER
*> N is the order of the Hessenberg matrix H upon which this
*> subroutine operates.
*> \endverbatim
*>
*> \param[in] KTOP
*> \verbatim
-*> KTOP is integer scalar
+*> KTOP is INTEGER
*> \endverbatim
*>
*> \param[in] KBOT
*> \verbatim
-*> KBOT is integer scalar
+*> KBOT is INTEGER
*> These are the first and last rows and columns of an
*> isolated diagonal block upon which the QR sweep is to be
*> applied. It is assumed without a check that
*>
*> \param[in] NSHFTS
*> \verbatim
-*> NSHFTS is integer scalar
+*> NSHFTS is INTEGER
*> NSHFTS gives the number of simultaneous shifts. NSHFTS
*> must be positive and even.
*> \endverbatim
*>
*> \param[in,out] S
*> \verbatim
-*> S is COMPLEX array of size (NSHFTS)
+*> S is COMPLEX array, dimension (NSHFTS)
*> S contains the shifts of origin that define the multi-
*> shift QR sweep. On output S may be reordered.
*> \endverbatim
*>
*> \param[in,out] H
*> \verbatim
-*> H is COMPLEX array of size (LDH,N)
+*> H is COMPLEX array, dimension (LDH,N)
*> On input H contains a Hessenberg matrix. On output a
*> multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
*> to the isolated diagonal block in rows and columns KTOP
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer scalar
+*> LDH is INTEGER
*> LDH is the leading dimension of H just as declared in the
*> calling procedure. LDH.GE.MAX(1,N).
*> \endverbatim
*>
*> \param[in,out] Z
*> \verbatim
-*> Z is COMPLEX array of size (LDZ,IHIZ)
+*> Z is COMPLEX array, dimension (LDZ,IHIZ)
*> If WANTZ = .TRUE., then the QR Sweep unitary
*> similarity transformation is accumulated into
*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right.
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer scalar
+*> LDZ is INTEGER
*> LDA is the leading dimension of Z just as declared in
*> the calling procedure. LDZ.GE.N.
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
-*> V is COMPLEX array of size (LDV,NSHFTS/2)
+*> V is COMPLEX array, dimension (LDV,NSHFTS/2)
*> \endverbatim
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> LDV is the leading dimension of V as declared in the
*> calling procedure. LDV.GE.3.
*> \endverbatim
*>
*> \param[out] U
*> \verbatim
-*> U is COMPLEX array of size
-*> (LDU,3*NSHFTS-3)
+*> U is COMPLEX array, dimension (LDU,3*NSHFTS-3)
*> \endverbatim
*>
*> \param[in] LDU
*> \verbatim
-*> LDU is integer scalar
+*> LDU is INTEGER
*> LDU is the leading dimension of U just as declared in the
*> in the calling subroutine. LDU.GE.3*NSHFTS-3.
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> NH is the number of columns in array WH available for
*> workspace. NH.GE.1.
*> \endverbatim
*>
*> \param[out] WH
*> \verbatim
-*> WH is COMPLEX array of size (LDWH,NH)
+*> WH is COMPLEX array, dimension (LDWH,NH)
*> \endverbatim
*>
*> \param[in] LDWH
*> \verbatim
-*> LDWH is integer scalar
+*> LDWH is INTEGER
*> Leading dimension of WH just as declared in the
*> calling procedure. LDWH.GE.3*NSHFTS-3.
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer scalar
+*> NV is INTEGER
*> NV is the number of rows in WV agailable for workspace.
*> NV.GE.1.
*> \endverbatim
*>
*> \param[out] WV
*> \verbatim
-*> WV is COMPLEX array of size
-*> (LDWV,3*NSHFTS-3)
+*> WV is COMPLEX array, dimension (LDWV,3*NSHFTS-3)
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer scalar
+*> LDWV is INTEGER
*> LDWV is the leading dimension of WV as declared in the
*> in the calling subroutine. LDWV.GE.NV.
*> \endverbatim
$ H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV,
$ WV, LDWV, NH, WH, LDWH )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexOTHERauxiliary
*
* =====================================================================
SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX, N
BETA = BETA*RSAFMN
ALPHI = ALPHI*RSAFMN
ALPHR = ALPHR*RSAFMN
- IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000)
+ IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) )
$ GO TO 10
*
* New BETA is at most 1, at least SAFMIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexOTHERauxiliary
*
* =====================================================================
SUBROUTINE CLARFGP( N, ALPHA, X, INCX, TAU )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX, N
BETA = BETA*BIGNUM
ALPHI = ALPHI*BIGNUM
ALPHR = ALPHR*BIGNUM
- IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000 )
+ IF( (ABS( BETA ).LT.SMLNUM) .AND. (KNT .LT. 20) )
$ GO TO 10
*
* New BETA is at most 1, at least SMLNUM
*>
*> \param[out] Z
*> \verbatim
-*> Z is array, dimension (LDZ, max(1,M) )
+*> Z is COMPLEX array, dimension (LDZ, max(1,M) )
*> If INFO = 0, the first M columns of Z contain the
*> orthonormal eigenvectors of the matrix T
*> corresponding to the input eigenvalues, with the i-th
$ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ,
$ WORK, IWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
* The first N entries of WORK are reserved for the eigenvalues
INDLD = N+1
INDLLD= 2*N+1
*> \verbatim
*> A is COMPLEX array, dimension (LDA,N)
*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and bleow the diagonal
+*> On exit, the elements on and below the diagonal
*> of the array contain the N-by-N lower triangular matrix L;
*> the elements above the diagonal represent Q by the rows
*> of blocked V (see Further Details).
SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
$ INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
*> \verbatim
*> IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
*> The vector of pivot indices. Only the elements in positions
-*> K1 through K1+(K2-K1)*INCX of IPIV are accessed.
-*> IPIV(K) = L implies rows K and L are to be interchanged.
+*> K1 through K1+(K2-K1)*abs(INCX) of IPIV are accessed.
+*> IPIV(K1+(K-K1)*abs(INCX)) = L implies rows K and L are to be
+*> interchanged.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
-*> The increment between successive values of IPIV. If IPIV
+*> The increment between successive values of IPIV. If INCX
*> is negative, the pivots are applied in reverse order.
*> \endverbatim
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexOTHERauxiliary
*
* =====================================================================
SUBROUTINE CLASWP( N, A, LDA, K1, K2, IPIV, INCX )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INCX, K1, K2, LDA, N
* ..
* .. Executable Statements ..
*
-* Interchange row I with row IPIV(I) for each of rows K1 through K2.
+* Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
+* K1 through K2.
*
IF( INCX.GT.0 ) THEN
IX0 = K1
* ===========
*
* SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-* H, LDH, WORK, INFO )
+* H, LDH, WORK )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
-* INTEGER J1, M, NB, LDA, LDH, INFO
+* INTEGER J1, M, NB, LDA, LDH
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[out] IPIV
*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
+*> IPIV is INTEGER array, dimension (M)
*> Details of the row and column interchanges,
*> the row and column k were interchanged with the row and
*> column IPIV(k).
*> WORK is REAL workspace, dimension (M).
*> \endverbatim
*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
*
* Authors:
* ========
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYcomputational
*
* =====================================================================
SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
- $ H, LDH, WORK, INFO )
+ $ H, LDH, WORK )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
* .. Scalar Arguments ..
CHARACTER UPLO
- INTEGER M, NB, J1, LDA, LDH, INFO
+ INTEGER M, NB, J1, LDA, LDH
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
*
* .. Local Scalars ..
- INTEGER J, K, K1, I1, I2
+ INTEGER J, K, K1, I1, I2, MJ
COMPLEX PIV, ALPHA
* ..
* .. External Functions ..
EXTERNAL LSAME, ILAENV, ICAMAX
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL CAXPY, CGEMV, CSCAL, CCOPY, CSWAP, CLASET,
+ $ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
* ..
* .. Executable Statements ..
*
- INFO = 0
J = 1
*
* K1 is the first column of the panel to be factorized
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
-* H(J:N, J) := A(J, J:N) - H(J:N, 1:(J-1)) * L(J1:(J-1), J),
-* where H(J:N, J) has been initialized to be A(J, J:N)
+* H(J:M, J) := A(J, J:M) - H(J:M, 1:(J-1)) * L(J1:(J-1), J),
+* where H(J:M, J) has been initialized to be A(J, J:M)
*
IF( K.GT.2 ) THEN
*
* > for the rest of the columns, K is J+1, skipping only the
* first column
*
- CALL CGEMV( 'No transpose', M-J+1, J-K1,
+ CALL CGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( 1, J ), 1,
$ ONE, H( J, J ), 1 )
END IF
*
-* Copy H(i:n, i) into WORK
+* Copy H(i:M, i) into WORK
*
- CALL CCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL CCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
-* Compute WORK := WORK - L(J-1, J:N) * T(J-1,J),
-* where A(J-1, J) stores T(J-1, J) and A(J-2, J:N) stores U(J-1, J:N)
+* Compute WORK := WORK - L(J-1, J:M) * T(J-1,J),
+* where A(J-1, J) stores T(J-1, J) and A(J-2, J:M) stores U(J-1, J:M)
*
ALPHA = -A( K-1, J )
- CALL CAXPY( M-J+1, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
+ CALL CAXPY( MJ, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
*
IF( J.LT.M ) THEN
*
-* Compute WORK(2:N) = T(J, J) L(J, (J+1):N)
-* where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N)
+* Compute WORK(2:M) = T(J, J) L(J, (J+1):M)
+* where A(J, J) stores T(J, J) and A(J-1, (J+1):M) stores U(J, (J+1):M)
*
IF( K.GT.1 ) THEN
ALPHA = -A( K, J )
$ WORK( 2 ), 1 )
ENDIF
*
-* Find max(|WORK(2:n)|)
+* Find max(|WORK(2:M)|)
*
I2 = ICAMAX( M-J, WORK( 2 ), 1 ) + 1
PIV = WORK( I2 )
WORK( I2 ) = WORK( I1 )
WORK( I1 ) = PIV
*
-* Swap A(I1, I1+1:N) with A(I1+1:N, I2)
+* Swap A(I1, I1+1:M) with A(I1+1:M, I2)
*
I1 = I1+J-1
I2 = I2+J-1
CALL CSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA,
$ A( J1+I1, I2 ), 1 )
*
-* Swap A(I1, I2+1:N) with A(I2, I2+1:N)
+* Swap A(I1, I2+1:M) with A(I2, I2+1:M)
*
CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
$ A( J1+I2-1, I2+1 ), LDA )
* Set A(J, J+1) = T(J, J+1)
*
A( K, J+1 ) = WORK( 2 )
- IF( (A( K, J ).EQ.ZERO ) .AND.
- $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
- IF(INFO .EQ. 0) THEN
- INFO = J
- ENDIF
- END IF
*
IF( J.LT.NB ) THEN
*
-* Copy A(J+1:N, J+1) into H(J:N, J),
+* Copy A(J+1:M, J+1) into H(J:M, J),
*
CALL CCOPY( M-J, A( K+1, J+1 ), LDA,
$ H( J+1, J+1 ), 1 )
END IF
*
-* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
-* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
+* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
*
IF( A( K, J+1 ).NE.ZERO ) THEN
ALPHA = ONE / A( K, J+1 )
CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO,
$ A( K, J+2 ), LDA)
END IF
- ELSE
- IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 10
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
-* H(J:N, J) := A(J:N, J) - H(J:N, 1:(J-1)) * L(J, J1:(J-1))^T,
-* where H(J:N, J) has been initialized to be A(J:N, J)
+* H(J:M, J) := A(J:M, J) - H(J:M, 1:(J-1)) * L(J, J1:(J-1))^T,
+* where H(J:M, J) has been initialized to be A(J:M, J)
*
IF( K.GT.2 ) THEN
*
* > for the rest of the columns, K is J+1, skipping only the
* first column
*
- CALL CGEMV( 'No transpose', M-J+1, J-K1,
+ CALL CGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( J, 1 ), LDA,
$ ONE, H( J, J ), 1 )
END IF
*
-* Copy H(J:N, J) into WORK
+* Copy H(J:M, J) into WORK
*
- CALL CCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL CCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
-* Compute WORK := WORK - L(J:N, J-1) * T(J-1,J),
+* Compute WORK := WORK - L(J:M, J-1) * T(J-1,J),
* where A(J-1, J) = T(J-1, J) and A(J, J-2) = L(J, J-1)
*
ALPHA = -A( J, K-1 )
- CALL CAXPY( M-J+1, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
+ CALL CAXPY( MJ, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
*
IF( J.LT.M ) THEN
*
-* Compute WORK(2:N) = T(J, J) L((J+1):N, J)
-* where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J)
+* Compute WORK(2:M) = T(J, J) L((J+1):M, J)
+* where A(J, J) = T(J, J) and A((J+1):M, J-1) = L((J+1):M, J)
*
IF( K.GT.1 ) THEN
ALPHA = -A( J, K )
$ WORK( 2 ), 1 )
ENDIF
*
-* Find max(|WORK(2:n)|)
+* Find max(|WORK(2:M)|)
*
I2 = ICAMAX( M-J, WORK( 2 ), 1 ) + 1
PIV = WORK( I2 )
WORK( I2 ) = WORK( I1 )
WORK( I1 ) = PIV
*
-* Swap A(I1+1:N, I1) with A(I2, I1+1:N)
+* Swap A(I1+1:M, I1) with A(I2, I1+1:M)
*
I1 = I1+J-1
I2 = I2+J-1
CALL CSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1,
$ A( I2, J1+I1 ), LDA )
*
-* Swap A(I2+1:N, I1) with A(I2+1:N, I2)
+* Swap A(I2+1:M, I1) with A(I2+1:M, I2)
*
CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
$ A( I2+1, J1+I2-1 ), 1 )
* Set A(J+1, J) = T(J+1, J)
*
A( J+1, K ) = WORK( 2 )
- IF( (A( J, K ).EQ.ZERO) .AND.
- $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
- IF (INFO .EQ. 0)
- $ INFO = J
- END IF
*
IF( J.LT.NB ) THEN
*
-* Copy A(J+1:N, J+1) into H(J+1:N, J),
+* Copy A(J+1:M, J+1) into H(J+1:M, J),
*
CALL CCOPY( M-J, A( J+1, K+1 ), 1,
$ H( J+1, J+1 ), 1 )
END IF
*
-* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
-* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
+* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
*
IF( A( J+1, K ).NE.ZERO ) THEN
ALPHA = ONE / A( J+1, K )
CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO,
$ A( J+2, K ), LDA )
END IF
- ELSE
- IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 30
*>
*> \param[out] ISUPPZ
*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
+*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
*> The support of the eigenvectors in Z, i.e., the indices
*> indicating the nonzero elements in Z. The i-th computed eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
$ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[out] ISUPPZ
*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
+*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
*> The support of the eigenvectors in Z, i.e., the indices
*> indicating the nonzero elements in Z. The i-th computed eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
$ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK,
$ IWORK, LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexSYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE CSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
$ WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* Definition:
* ===========
*
-* SUBROUTINE CSYCONVF( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+* SUBROUTINE CSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE CSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO, WAY
* Definition:
* ===========
*
-* SUBROUTINE CSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+* SUBROUTINE CSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE CSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYcomputational
*
* =====================================================================
SUBROUTINE CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, N
EXTERNAL LSAME, SLAMCH
* ..
* .. External Subroutines ..
- EXTERNAL CLASSQ
+ EXTERNAL CLASSQ, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, AIMAG, INT, LOG, MAX, MIN, REAL, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYsolve
*
SUBROUTINE CSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL ILAENV, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, CSYTRF, CSYTRS, CSYTRS2
+ EXTERNAL XERBLA, CSYTRF_AA, CSYTRS_AA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief <b> CSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYSV_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csysv_aasen_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csysv_aasen_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csysv_aasen_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+* IPIV, IPIV2, B, LDB, WORK, LWORK,
+* INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX A( LDA, * ), TB( * ), B( LDB, *), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CSYSV_AA_2STAGE computes the solution to a complex system of
+*> linear equations
+*> A * X = B,
+*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+*> matrices.
+*>
+*> Aasen's 2-stage algorithm is used to factor A as
+*> A = U * T * U**H, if UPLO = 'U', or
+*> A = L * T * L**H, if UPLO = 'L',
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is symmetric and band. The matrix T is
+*> then LU-factored with partial pivoting. The factored form of A
+*> is then used to solve the system of equations A * X = B.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complexSYcomputational
+*
+* =====================================================================
+ SUBROUTINE CSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, WORK, LWORK,
+ $ INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LDB, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX A( LDA, * ), B( LDB, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER LWKOPT
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL CSYTRF_AA_2STAGE,
+ $ CSYTRS_AA_2STAGE, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ CALL CSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
+ $ IPIV2, WORK, -1, INFO )
+ LWKOPT = INT( WORK(1) )
+ IF( LTB.LT.INT( TB(1) ) .AND. .NOT.TQUERY ) THEN
+ INFO = -7
+ ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.WQUERY ) THEN
+ INFO = -13
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'CSYSV_AA_2STAGE', -INFO )
+ RETURN
+ ELSE IF( WQUERY .OR. TQUERY ) THEN
+ RETURN
+ END IF
+*
+*
+* Compute the factorization A = U*T*U**H or A = L*T*L**H.
+*
+ CALL CSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
+ $ WORK, LWORK, INFO )
+ IF( INFO.EQ.0 ) THEN
+*
+* Solve the system A*X = B, overwriting B with X.
+*
+ CALL CSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, B, LDB, INFO )
+*
+ END IF
+*
+ WORK( 1 ) = LWKOPT
+*
+* End of CSYSV_AA_2STAGE
+*
+ END
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYcomputational
*
* =====================================================================
SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
*
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
- INTEGER J, LWKOPT, IINFO
+ INTEGER J, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
COMPLEX ALPHA
* ..
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL CLASYF_AA, CGEMM, CGEMV, CSCAL, CSWAP, CCOPY,
+ $ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*
* Determine the block size
*
- NB = ILAENV( 1, 'CSYTRF', UPLO, N, -1, -1, -1 )
+ NB = ILAENV( 1, 'CSYTRF_AA', UPLO, N, -1, -1, -1 )
*
* Test the input parameters.
*
ENDIF
IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN
- IF ( A( 1, 1 ).EQ.ZERO ) THEN
- INFO = 1
- END IF
RETURN
END IF
*
-* Adjubst block size based on the workspace size
+* Adjust block size based on the workspace size
*
IF( LWORK.LT.((1+NB)*N) ) THEN
NB = ( LWORK-N ) / N
*
CALL CLASYF_AA( UPLO, 2-K1, N-J, JB,
$ A( MAX(1, J), J+1 ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
- $ IINFO )
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
*
CALL CLASYF_AA( UPLO, 2-K1, N-J, JB,
$ A( J+1, MAX(1, J) ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
--- /dev/null
+*> \brief \b CSYTRF_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYTRF_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytrf_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytrf_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytrf_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+* IPIV2, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CSYTRF_AA_2STAGE computes the factorization of a complex symmetric matrix A
+*> using the Aasen's algorithm. The form of the factorization is
+*>
+*> A = U*T*U**T or A = L*T*L**T
+*>
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is a complex symmetric band matrix with the
+*> bandwidth of NB (NB is internally selected and stored in TB( 1 ), and T is
+*> LU factorized with partial pivoting).
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> On entry, the hermitian matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complexSYcomputational
+*
+* =====================================================================
+ SUBROUTINE CSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, WORK, LWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+* .. Parameters ..
+ COMPLEX CZERO, CONE
+ PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
+ $ CONE = ( 1.0E+0, 0.0E+0 ) )
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER I, J, K, I1, I2, TD
+ INTEGER LDTB, NB, KB, JB, NT, IINFO
+ COMPLEX PIV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL CCOPY, CGBTRF, CGEMM, CGETRF, CLACPY,
+ $ CLASET, CTRSM, CSWAP, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN
+ INFO = -6
+ ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN
+ INFO = -10
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'CSYTRF_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Answer the query
+*
+ NB = ILAENV( 1, 'CSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
+ IF( INFO.EQ.0 ) THEN
+ IF( TQUERY ) THEN
+ TB( 1 ) = (3*NB+1)*N
+ END IF
+ IF( WQUERY ) THEN
+ WORK( 1 ) = N*NB
+ END IF
+ END IF
+ IF( TQUERY .OR. WQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return
+*
+ IF ( N.EQ.0 ) THEN
+ RETURN
+ ENDIF
+*
+* Determine the number of the block size
+*
+ LDTB = LTB/N
+ IF( LDTB .LT. 3*NB+1 ) THEN
+ NB = (LDTB-1)/3
+ END IF
+ IF( LWORK .LT. NB*N ) THEN
+ NB = LWORK/N
+ END IF
+*
+* Determine the number of the block columns
+*
+ NT = (N+NB-1)/NB
+ TD = 2*NB
+ KB = MIN(NB, N)
+*
+* Initialize vectors/matrices
+*
+ DO J = 1, KB
+ IPIV( J ) = J
+ END DO
+*
+* Save NB
+*
+ TB( 1 ) = NB
+*
+ IF( UPPER ) THEN
+*
+* .....................................................
+* Factorize A as L*D*L**T using the upper triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*U(I,J) + T(I+1,I)*U(I+1,J)
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ CONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( (I-1)*NB+1, J*NB+1 ), LDA,
+ $ CZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*U(I-1,J) + T(I,I)*U(I,J) + T(I,I+1)*U(I+1,J)
+ IF( I .EQ. J-1) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ CONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (I-2)*NB+1, J*NB+1 ), LDA,
+ $ CZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL CLACPY( 'Upper', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = U(1:J,J)'*H(1:J)
+ CALL CGEMM( 'Transpose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -CONE, A( 1, J*NB+1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += U(J,J)'*T(J,J-1)*U(J-1,J)
+ CALL CGEMM( 'Transpose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ CONE, A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ CZERO, WORK( 1 ), N )
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB,
+ $ -CONE, WORK( 1 ), N,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ $ = TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ IF( J.GT.0 ) THEN
+c CALL CHEGST( 1, 'Upper', KB,
+c $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+c $ A( (J-1)*NB+1, J*NB+1 ), LDA, IINFO )
+ CALL CTRSM( 'L', 'U', 'T', 'N', KB, KB, CONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ CALL CTRSM( 'R', 'U', 'N', 'N', KB, KB, CONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, KB,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ CZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB+KB,
+ $ CONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ CZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL CGEMM( 'Transpose', 'NoTranspose',
+ $ NB, N-(J+1)*NB, J*NB,
+ $ -CONE, WORK( NB+1 ), N,
+ $ A( 1, (J+1)*NB+1 ), LDA,
+ $ CONE, A( J*NB+1, (J+1)*NB+1 ), LDA )
+ END IF
+*
+* Copy panel to workspace to call CGETRF
+*
+ DO K = 1, NB
+ CALL CCOPY( N-(J+1)*NB,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA,
+ $ WORK( 1+(K-1)*N ), 1 )
+ END DO
+*
+* Factorize panel
+*
+ CALL CGETRF( N-(J+1)*NB, NB,
+ $ WORK, N,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Copy panel back
+*
+ DO K = 1, NB
+ CALL CCOPY( N-(J+1)*NB,
+ $ WORK( 1+(K-1)*N ), 1,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA )
+ END DO
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL CLASET( 'Full', KB, NB, CZERO, CZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL CLACPY( 'Upper', KB, NB,
+ $ WORK, N,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL CTRSM( 'R', 'U', 'N', 'U', KB, NB, CONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J,J+1) into T(J+1, J), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB )
+ $ = TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ CALL CLASET( 'Lower', KB, NB, CZERO, CONE,
+ $ A( J*NB+1, (J+1)*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL CSWAP( K-1, A( (J+1)*NB+1, I1 ), 1,
+ $ A( (J+1)*NB+1, I2 ), 1 )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL CSWAP( I2-I1-1, A( I1, I1+1 ), LDA,
+ $ A( I1+1, I2 ), 1 )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL CSWAP( N-I2, A( I1, I2+1 ), LDA,
+ $ A( I2, I2+1 ), LDA )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL CSWAP( J*NB, A( 1, I1 ), 1,
+ $ A( 1, I2 ), 1 )
+ END IF
+ ENDIF
+ END DO
+ END IF
+ END DO
+ ELSE
+*
+* .....................................................
+* Factorize A as L*D*L**T using the lower triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*L(J,I)' + T(I+1,I)'*L(J,I+1)'
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL CGEMM( 'NoTranspose', 'Transpose',
+ $ NB, KB, JB,
+ $ CONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (I-1)*NB+1 ), LDA,
+ $ CZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*L(J,I-1)' + T(I,I)*L(J,I)' + T(I,I+1)*L(J,I+1)'
+ IF( I .EQ. (J-1) ) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL CGEMM( 'NoTranspose', 'Transpose',
+ $ NB, KB, JB,
+ $ CONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (I-2)*NB+1 ), LDA,
+ $ CZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL CLACPY( 'Lower', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = L(J,1:J)*H(1:J)
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -CONE, A( J*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += L(J,J)*T(J,J-1)*L(J,J-1)'
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ CONE, A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ CZERO, WORK( 1 ), N )
+ CALL CGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, NB,
+ $ -CONE, WORK( 1 ), N,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ $ = TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ END DO
+ END DO
+ IF( J.GT.0 ) THEN
+c CALL CHEGST( 1, 'Lower', KB,
+c $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+c $ A( J*NB+1, (J-1)*NB+1 ), LDA, IINFO )
+ CALL CTRSM( 'L', 'L', 'N', 'N', KB, KB, CONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ CALL CTRSM( 'R', 'L', 'T', 'N', KB, KB, CONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Symmetrize T(J,J)
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ $ = TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL CGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, KB,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ CZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL CGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, NB+KB,
+ $ CONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ CZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL CGEMM( 'NoTranspose', 'NoTranspose',
+ $ N-(J+1)*NB, NB, J*NB,
+ $ -CONE, A( (J+1)*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ CONE, A( (J+1)*NB+1, J*NB+1 ), LDA )
+ END IF
+*
+* Factorize panel
+*
+ CALL CGETRF( N-(J+1)*NB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL CLASET( 'Full', KB, NB, CZERO, CZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL CLACPY( 'Upper', KB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL CTRSM( 'R', 'L', 'T', 'U', KB, NB, CONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J+1,J) into T(J, J+1), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB ) =
+ $ TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ CALL CLASET( 'Upper', KB, NB, CZERO, CONE,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL CSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA,
+ $ A( I2, (J+1)*NB+1 ), LDA )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL CSWAP( I2-I1-1, A( I1+1, I1 ), 1,
+ $ A( I2, I1+1 ), LDA )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL CSWAP( N-I2, A( I2+1, I1 ), 1,
+ $ A( I2+1, I2 ), 1 )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL CSWAP( J*NB, A( I1, 1 ), LDA,
+ $ A( I2, 1 ), LDA )
+ END IF
+ ENDIF
+ END DO
+*
+* Apply pivots to previous columns of L
+*
+c CALL CLASWP( J*NB, A( 1, 1 ), LDA,
+c $ (J+1)*NB+1, (J+1)*NB+KB, IPIV, 1 )
+ END IF
+ END DO
+ END IF
+*
+* Factor the band matrix
+ CALL CGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO )
+*
+* End of CSYTRF_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYcomputational
*
* =====================================================================
SUBROUTINE CSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL CSYTRI, CSYTRI2X
+ EXTERNAL CSYTRI, CSYTRI2X, XERBLA
* ..
* .. Executable Statements ..
*
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension (N+NNB+1,NNB+3)
+*> WORK is COMPLEX array, dimension (N+NB+1,NB+3)
*> \endverbatim
*>
*> \param[in] NB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexSYcomputational
*
* =====================================================================
SUBROUTINE CSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE CSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL CSYTRI_3X
+ EXTERNAL CSYTRI_3X, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexSYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE CSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexSYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> of the matrix B. NRHS >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is REAL array, dimension (LDA,N)
*> Details of factors computed by CSYTRF_AA.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexSYcomputational
*
SUBROUTINE CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL CGTSV, CSWAP, CTRSM, XERBLA
+ EXTERNAL CLACPY, CGTSV, CSWAP, CTRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief \b CSYTRS_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CSYTRS_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytrs_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytrs_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytrs_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+* IPIV2, B, LDB, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CSYTRS_AA_2STAGE solves a system of linear equations A*X = B with a complex
+*> symmetric matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by CSYTRF_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the details of the factorization are stored
+*> as an upper or lower triangular matrix.
+*> = 'U': Upper triangular, form is A = U*T*U**T;
+*> = 'L': Lower triangular, form is A = L*T*L**T.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> Details of factors computed by CSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX array, dimension (LTB)
+*> Details of factors computed by CSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> CSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] IPIV2
+*> \verbatim
+*> IPIV2 is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> CSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complexSYcomputational
+*
+* =====================================================================
+ SUBROUTINE CSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+* =====================================================================
+*
+ COMPLEX ONE
+ PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER LDTB, NB
+ LOGICAL UPPER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL CGBTRS, CLASWP, CTRSM, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LTB.LT.( 4*N ) ) THEN
+ INFO = -7
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'CSYTRS_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. NRHS.EQ.0 )
+ $ RETURN
+*
+* Read NB and compute LDTB
+*
+ NB = INT( TB( 1 ) )
+ LDTB = LTB/N
+*
+ IF( UPPER ) THEN
+*
+* Solve A*X = B, where A = U*T*U**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ]
+*
+ CALL CTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (U**T \P**T * B) ]
+*
+ CALL CGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ]
+*
+ CALL CTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ]
+*
+ CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+*
+ ELSE
+*
+* Solve A*X = B, where A = L*T*L**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
+*
+ CALL CTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (L \P**T * B) ]
+*
+ CALL CGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
+*
+ CALL CTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
+*
+ CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of CSYTRS_AA_2STAGE
+*
+ END
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX arrays, dimensions (LDA,N)
+*> A is COMPLEX array, dimension (LDA,N)
*> On entry, the matrix A in the pair (A, B).
*> On exit, the updated matrix A.
*> \endverbatim
*>
*> \param[in,out] B
*> \verbatim
-*> B is COMPLEX arrays, dimensions (LDB,N)
+*> B is COMPLEX array, dimension (LDB,N)
*> On entry, the matrix B in the pair (A, B).
*> On exit, the updated matrix B.
*> \endverbatim
*>
*> \param[in,out] Q
*> \verbatim
-*> Q is COMPLEX array, dimension (LDZ,N)
+*> Q is COMPLEX array, dimension (LDQ,N)
*> If WANTQ = .TRUE, on entry, the unitary matrix Q. On exit,
*> the updated matrix Q.
*> Not referenced if WANTQ = .FALSE..
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexGEauxiliary
*
SUBROUTINE CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
$ LDZ, J1, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL WANTQ, WANTZ
*>
*> \param[in,out] Q
*> \verbatim
-*> Q is COMPLEX array, dimension (LDZ,N)
+*> Q is COMPLEX array, dimension (LDQ,N)
*> On entry, if WANTQ = .TRUE., the unitary matrix Q.
*> On exit, the updated matrix Q.
*> If WANTQ = .FALSE., Q is not referenced.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexGEcomputational
*
SUBROUTINE CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
$ LDZ, IFST, ILST, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL WANTQ, WANTZ
*
*> \param[in] IJOB
*> \verbatim
-*> IJOB is integer
+*> IJOB is INTEGER
*> Specifies whether condition numbers are required for the
*> cluster of eigenvalues (PL and PR) or the deflating subspaces
*> (Difu and Difl):
$ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF,
$ WORK, LWORK, IWORK, LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX array, dimension (LDA,N)
-*> On entry, the lower triangular N-by-N matrix A.
+*> A is COMPLEX array, dimension (LDA,M)
+*> On entry, the lower triangular M-by-M matrix A.
*> On exit, the elements on and below the diagonal of the array
*> contain the lower triangular matrix L.
*> \endverbatim
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[in,out] B
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*> C = [ A ] [ B ]
*>
*>
-*> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*> where A is an lower triangular M-by-M matrix, and B is M-by-N pentagonal
*> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L
*> upper trapezoidal matrix B2:
*> [ B ] = [ B1 ] [ B2 ]
*> [ B1 ] <- M-by-(N-L) rectangular
-*> [ B2 ] <- M-by-L upper trapezoidal.
+*> [ B2 ] <- M-by-L lower trapezoidal.
*>
*> The lower trapezoidal matrix B2 consists of the first L columns of a
-*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
+*> M-by-M lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
*> B is rectangular M-by-N; if M=L=N, B is lower triangular.
*>
*> The matrix W stores the elementary reflectors H(i) in the i-th row
*> above the diagonal (of A) in the M-by-(M+N) input matrix C
*> [ C ] = [ A ] [ B ]
-*> [ A ] <- lower triangular N-by-N
+*> [ A ] <- lower triangular M-by-M
*> [ B ] <- M-by-N pentagonal
*>
*> so that W can be represented as
*> [ W ] = [ I ] [ V ]
-*> [ I ] <- identity, N-by-N
+*> [ I ] <- identity, M-by-M
*> [ V ] <- M-by-N, same form as B.
*>
*> Thus, all of information needed for W is contained on exit in B, which
SUBROUTINE CTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LDT, N, M, L, MB
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX array, dimension (LDA,N)
+*> A is COMPLEX array, dimension (LDA,M)
*> On entry, the lower triangular M-by-M matrix A.
*> On exit, the elements on and below the diagonal of the array
*> contain the lower triangular matrix L.
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[in,out] B
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*> C = [ A ][ B ]
*>
*>
-*> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*> where A is an lower triangular M-by-M matrix, and B is M-by-N pentagonal
*> matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L
*> upper trapezoidal matrix B2:
*>
*> above the diagonal (of A) in the M-by-(M+N) input matrix C
*>
*> C = [ A ][ B ]
-*> [ A ] <- lower triangular N-by-N
+*> [ A ] <- lower triangular M-by-M
*> [ B ] <- M-by-N pentagonal
*>
*> so that W can be represented as
*>
*> W = [ I ][ V ]
-*> [ I ] <- identity, N-by-N
+*> [ I ] <- identity, M-by-M
*> [ V ] <- M-by-N, same form as B.
*>
*> Thus, all of information needed for W is contained on exit in B, which
* =====================================================================
SUBROUTINE CTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LDT, N, M, L
*>
*> \verbatim
*>
-*> CTPMQRT applies a complex orthogonal matrix Q obtained from a
-*> "triangular-pentagonal" real block reflector H to a general
-*> real matrix C, which consists of two blocks A and B.
+*> CTPMLQT applies a complex orthogonal matrix Q obtained from a
+*> "triangular-pentagonal" complex block reflector H to a general
+*> complex matrix C, which consists of two blocks A and B.
*> \endverbatim
*
* Arguments:
*> \param[in] SIDE
*> \verbatim
*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**C from the Left;
-*> = 'R': apply Q or Q**C from the Right.
+*> = 'L': apply Q or Q**H from the Left;
+*> = 'R': apply Q or Q**H from the Right.
*> \endverbatim
*>
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': No transpose, apply Q;
-*> = 'C': Transpose, apply Q**C.
+*> = 'C': Transpose, apply Q**H.
*> \endverbatim
*>
*> \param[in] M
*> (LDA,K) if SIDE = 'R'
*> On entry, the K-by-N or M-by-K matrix A.
*> On exit, A is overwritten by the corresponding block of
-*> Q*C or Q**C*C or C*Q or C*Q**C. See Further Details.
+*> Q*C or Q**H*C or C*Q or C*Q**H. See Further Details.
*> \endverbatim
*>
*> \param[in] LDA
*> B is COMPLEX array, dimension (LDB,N)
*> On entry, the M-by-N matrix B.
*> On exit, B is overwritten by the corresponding block of
-*> Q*C or Q**C*C or C*Q or C*Q**C. See Further Details.
+*> Q*C or Q**H*C or C*Q or C*Q**H. See Further Details.
*> \endverbatim
*>
*> \param[in] LDB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*>
*> If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
*>
-*> If TRANS='C' and SIDE='L', C is on exit replaced with Q**C * C.
+*> If TRANS='C' and SIDE='L', C is on exit replaced with Q**H * C.
*>
*> If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
*>
-*> If TRANS='C' and SIDE='R', C is on exit replaced with C * Q**C.
+*> If TRANS='C' and SIDE='R', C is on exit replaced with C * Q**H.
*> \endverbatim
*>
* =====================================================================
SUBROUTINE CTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
$ A, LDA, B, LDB, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complexOTHERcomputational
*
SUBROUTINE CTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
$ A, LDA, B, LDB, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL CTPRFB, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
* @generated from ztrevc3.f, fortran z -> c, Tue Apr 19 01:47:44 2016
*
$ LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, CCOPY, CLASET, CSSCAL, CGEMM, CGEMV,
- $ CLATRS, SLABAD
+ $ CLATRS, CLACPY, SLABAD
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, REAL, CMPLX, CONJG, AIMAG, MAX
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
LOGICAL LQUERY
* ..
* .. External Subroutines ..
- EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, XERBLA
+ EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, CLACGV,
+ $ XERBLA
* ..
* .. External Functions ..
REAL SCNRM2
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
LOGICAL LQUERY
* ..
* .. External Subroutines ..
- EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, XERBLA
+ EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CLACGV, XERBLA
* ..
* .. External Functions ..
REAL SCNRM2
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
$ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
LOGICAL LQUERY
* ..
* .. External Subroutines ..
- EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, XERBLA
+ EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, CLACGV,
+ $ XERBLA
* ..
* .. External Functions ..
REAL SCNRM2
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE CUNBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
$ LDQ2, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
$ LDQ2, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*>
*> \param[out] U1
*> \verbatim
-*> U1 is COMPLEX array, dimension (P)
+*> U1 is COMPLEX array, dimension (LDU1,P)
*> If JOBU1 = 'Y', U1 contains the P-by-P unitary matrix U1.
*> \endverbatim
*>
*>
*> \param[out] U2
*> \verbatim
-*> U2 is COMPLEX array, dimension (M-P)
+*> U2 is COMPLEX array, dimension (LDU2,M-P)
*> If JOBU2 = 'Y', U2 contains the (M-P)-by-(M-P) unitary
*> matrix U2.
*> \endverbatim
*>
*> \param[out] V1T
*> \verbatim
-*> V1T is COMPLEX array, dimension (Q)
+*> V1T is COMPLEX array, dimension (LDV1T,Q)
*> If JOBV1T = 'Y', V1T contains the Q-by-Q matrix unitary
*> matrix V1**H.
*> \endverbatim
*>
*> \param[out] V2T
*> \verbatim
-*> V2T is COMPLEX array, dimension (M-Q)
+*> V2T is COMPLEX array, dimension (LDV2T,M-Q)
*> If JOBV2T = 'Y', V2T contains the (M-Q)-by-(M-Q) unitary
*> matrix V2**H.
*> \endverbatim
$ LDV2T, WORK, LWORK, RWORK, LRWORK,
$ IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
$ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> N2-by-N2 upper triangular matrix.
*> \endverbatim
*
-* Arguments
-* =========
+* Arguments:
+* ==========
*
*> \param[in] SIDE
*> \verbatim
SUBROUTINE CUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.6.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2015
*>
*> \param[in,out] V2T
*> \verbatim
-*> V2T is DOUBLE PRECISION array, dimenison (LDV2T,M-Q)
+*> V2T is DOUBLE PRECISION array, dimension (LDV2T,M-Q)
*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is
*> premultiplied by the transpose of the right
*> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and
$ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E,
$ B22D, B22E, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
$ WORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
WSTART = 1
QSTART = 3
IF( ICOMPQ.EQ.1 ) THEN
- CALL DCOPY( N, D, 1, Q( 1 ), 1 )
+ CALL DCOPY( N, D, 1, Q( 1 ), 1 )
CALL DCOPY( N-1, E, 1, Q( N+1 ), 1 )
END IF
IF( IUPLO.EQ.2 ) THEN
QSTART = 5
- WSTART = 2*N - 1
+ IF( ICOMPQ .EQ. 2 ) WSTART = 2*N - 1
DO 10 I = 1, N - 1
CALL DLARTG( D( I ), E( I ), CS, SN, R )
D( I ) = R
*> algorithm through its inner loop. The algorithms stops
*> (and so fails to converge) if the number of passes
*> through the inner loop exceeds MAXITR*N**2.
+*>
*> \endverbatim
*
*> \par Note:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
$ LDU, C, LDC, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
ELSE IF( NRU.LT.0 ) THEN
INFO = -4
ELSE IF( NCC.LT.0 ) THEN
- INFO = -5
+ INFO = -5
ELSE IF( ( NCVT.EQ.0 .AND. LDVT.LT.1 ) .OR.
$ ( NCVT.GT.0 .AND. LDVT.LT.MAX( 1, N ) ) ) THEN
INFO = -9
*
IF( M.LE.1 )
$ GO TO 160
-*
+*
IF( ITER.GE.N ) THEN
ITER = ITER - N
ITERDIVN = ITERDIVN + 1
- IF (ITERDIVN.GE.MAXITDIVN )
- $ GO TO 200
+ IF( ITERDIVN.GE.MAXITDIVN )
+ $ GO TO 200
END IF
*
* Find diagonal block of matrix to work on
SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
$ NS, S, Z, LDZ, WORK, IWORK, INFO)
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, RANGE, UPLO
EXTERNAL IDAMAX, LSAME, DAXPY, DDOT, DLAMCH, DNRM2
* ..
* .. External Subroutines ..
- EXTERNAL DCOPY, DLASET, DSCAL, DSWAP
+ EXTERNAL DSTEVX, DCOPY, DLASET, DSCAL, DSWAP, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, SIGN, SQRT
*>
*> \param[in,out] A
*> \verbatim
-*> A is DOUBLE array, dimension (LDA,N)
+*> A is DOUBLE PRECISION array, dimension (LDA,N)
*> On entry, the input matrix A.
*> On exit, A is overwritten by the balanced matrix.
*> If JOB = 'N', A is not referenced.
*>
*> \param[out] SCALE
*> \verbatim
-*> SCALE is DOUBLE array, dimension (N)
+*> SCALE is DOUBLE PRECISION array, dimension (N)
*> Details of the permutations and scaling factors applied to
*> A. If P(j) is the index of the row and column interchanged
*> with row and column j and D(j) is the scaling factor
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
* =====================================================================
SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOB
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is DOUBLE PRECISION array dimension (min(M,N))
+*> TAUQ is DOUBLE PRECISION array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the orthogonal matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
* =====================================================================
SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is DOUBLE PRECISION array dimension (min(M,N))
+*> TAUQ is DOUBLE PRECISION array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the orthogonal matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
- $ NBMIN, NX
- DOUBLE PRECISION WS
+ $ NBMIN, NX, WS
* ..
* .. External Subroutines ..
EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension at least LWORK.
+*> WORK is DOUBLE PRECISION array, dimension (LWORK)
*> On exit, if N.GT.0 .AND. M.GT.0 (else not referenced),
*> WORK(1) = SCALE = WORK(2) / WORK(1) is the scaling factor such
*> that SCALE*SVA(1:N) are the computed singular values
*>
*> \param[out] IWORK
*> \verbatim
-*> IWORK is INTEGER array, dimension M+3*N.
+*> IWORK is INTEGER array, dimension (M+3*N).
*> On exit,
*> IWORK(1) = the numerical rank determined after the initial
*> QR factorization with pivoting. See the descriptions
$ M, N, A, LDA, SVA, U, LDU, V, LDV,
$ WORK, LWORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
*>
*> \verbatim
*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
+*> The matrix V stores the elementary reflectors H(i) in the i-th row
+*> above the diagonal. For example, if M=5 and N=3, the matrix V is
*>
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
*>
*> where the vi's represent the vectors which define H(i), which are returned
*> in the matrix A. The 1's along the diagonal of V are not stored in A.
-*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each
-*> block is of order NB except for the last block, which is of order
-*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
-*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
+*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/MB), where each
+*> block is of order MB except for the last block, which is of order
+*> IB = K - (B-1)*MB. For each of the B blocks, a upper triangular block
+*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB
+*> for the last block) T's are stored in the MB-by-K matrix T as
*>
*> T = (T1 T2 ... TB).
*> \endverbatim
* =====================================================================
SUBROUTINE DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDT, M, N, MB
INTEGER I, IB, IINFO, K
* ..
* .. External Subroutines ..
- EXTERNAL DGEQRT2, DGEQRT3, DLARFB, XERBLA
+ EXTERNAL DGEQRT2, DGELQT3, DGEQRT3, DLARFB, XERBLA
* ..
* .. Executable Statements ..
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
*>
*> \verbatim
*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
+*> The matrix V stores the elementary reflectors H(i) in the i-th row
+*> above the diagonal. For example, if M=5 and N=3, the matrix V is
*>
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
* =====================================================================
RECURSIVE SUBROUTINE DGELQT3( M, N, A, LDA, T, LDT, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, LDT
PARAMETER ( ONE = 1.0D+00 )
* ..
* .. Local Scalars ..
- INTEGER I, I1, J, J1, M1, M2, N1, N2, IINFO
+ INTEGER I, I1, J, J1, M1, M2, IINFO
* ..
* .. External Subroutines ..
EXTERNAL DLARFG, DTRMM, DGEMM, XERBLA
*> of the matrices B and X. NRHS >= 0.
*> \endverbatim
*>
-*> \param[in] A
+*> \param[in,out] A
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,N)
*> On entry, the M-by-N matrix A.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEsolve
*
SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
$ WORK, LWORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
-*> Download DGEMQRT + dependencies
+*> Download DGEMLQT + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgemlqt.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgemlqt.f">
*>
*> \verbatim
*>
-*> DGEMQRT overwrites the general real M-by-N matrix C with
+*> DGEMLQT overwrites the general real M-by-N matrix C with
*>
*> SIDE = 'L' SIDE = 'R'
*> TRANS = 'N': Q C C Q
*>
*> \param[in] V
*> \verbatim
-*> V is DOUBLE PRECISION array, dimension (LDV,K)
+*> V is DOUBLE PRECISION array, dimension
+*> (LDV,M) if SIDE = 'L',
+*> (LDV,N) if SIDE = 'R'
*> The i-th row must contain the vector which defines the
*> elementary reflector H(i), for i = 1,2,...,k, as returned by
*> DGELQT in the first K rows of its array argument A.
*> \param[in] LDV
*> \verbatim
*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
+*> The leading dimension of the array V. LDV >= max(1,K).
*> \endverbatim
*>
*> \param[in] T
*> \verbatim
*> T is DOUBLE PRECISION array, dimension (LDT,K)
*> The upper triangular factors of the block reflectors
-*> as returned by DGELQT, stored as a MB-by-M matrix.
+*> as returned by DGELQT, stored as a MB-by-K matrix.
*> \endverbatim
*>
*> \param[in] LDT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
SUBROUTINE DGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT,
$ C, LDC, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN
- INTEGER I, IB, LDWORK, KF, Q
+ INTEGER I, IB, LDWORK, KF
* ..
* .. External Functions ..
LOGICAL LSAME
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
*> block is of order NB except for the last block, which is of order
*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
+*> for the last block) T's are stored in the NB-by-K matrix T as
*>
*> T = (T1 T2 ... TB).
*> \endverbatim
* =====================================================================
SUBROUTINE DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDT, M, N, NB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEauxiliary
*
* =====================================================================
SUBROUTINE DGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER LDA, N
DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TEMP
* ..
* .. External Subroutines ..
- EXTERNAL DLASWP, DSCAL
+ EXTERNAL DLASWP, DSCAL, DLABAD
* ..
* .. External Functions ..
INTEGER IDAMAX
$ IL, IU, NS, S, U, LDU, VT, LDVT, WORK,
$ LWORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. External Subroutines ..
EXTERNAL DBDSVDX, DGEBRD, DGELQF, DGEQRF, DLACPY,
$ DLASCL, DLASET, DORMBR, DORMLQ, DORMQR,
- $ XERBLA
+ $ DCOPY, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
*
*> \param[in] JOBA
*> \verbatim
-*> JOBA is CHARACTER* 1
+*> JOBA is CHARACTER*1
*> Specifies the structure of A.
*> = 'L': The input matrix A is lower triangular;
*> = 'U': The input matrix A is upper triangular;
*>
*> \param[in,out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension MAX(6,M+N).
+*> WORK is DOUBLE PRECISION array, dimension (LWORK)
*> On entry :
*> If JOBU .EQ. 'C' :
*> WORK(1) = CTOL, where CTOL defines the threshold for convergence.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
$ LDV, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDV, LWORK, M, MV, N
* =====================================================================
SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
DOUBLE PRECISION BIGNUM, EPS, SMIN, SMLNUM, XMAX
* ..
* .. External Subroutines ..
- EXTERNAL DGER, DSWAP
+ EXTERNAL DGER, DSWAP, DLABAD
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMCH
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEsolve
*
SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS
INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW,
$ SCLLEN, MNK, TSZO, TSZM, LWO, LWM, LW1, LW2,
$ WSIZEO, WSIZEM, INFO2
- DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM, TQ( 5 ), WORKQ
+ DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM, TQ( 5 ), WORKQ( 1 )
* ..
* .. External Functions ..
LOGICAL LSAME
IF( M.GE.N ) THEN
CALL DGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
- LWO = INT( WORKQ )
+ LWO = INT( WORKQ( 1 ) )
CALL DGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWO = MAX( LWO, INT( WORKQ ) )
+ LWO = MAX( LWO, INT( WORKQ( 1 ) ) )
CALL DGEQR( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
TSZM = INT( TQ( 1 ) )
- LWM = INT( WORKQ )
+ LWM = INT( WORKQ( 1 ) )
CALL DGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
$ TSZM, B, LDB, WORKQ, -1, INFO2 )
- LWM = MAX( LWM, INT( WORKQ ) )
+ LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
WSIZEO = TSZO + LWO
WSIZEM = TSZM + LWM
ELSE
CALL DGELQ( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
- LWO = INT( WORKQ )
+ LWO = INT( WORKQ( 1 ) )
CALL DGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWO = MAX( LWO, INT( WORKQ ) )
+ LWO = MAX( LWO, INT( WORKQ( 1 ) ) )
CALL DGELQ( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
TSZM = INT( TQ( 1 ) )
- LWM = INT( WORKQ )
+ LWM = INT( WORKQ( 1 ) )
CALL DGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWM = MAX( LWM, INT( WORKQ ) )
+ LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
WSIZEO = TSZO + LWO
WSIZEM = TSZM + LWM
END IF
*>
*> \param[in] SELCTG
*> \verbatim
-*> SELCTG is procedure) LOGICAL FUNCTION of three DOUBLE PRECISION arguments
+*> SELCTG is a LOGICAL FUNCTION of three DOUBLE PRECISION arguments
*> SELCTG must be declared EXTERNAL in the calling subroutine.
*> If SORT = 'N', SELCTG is not referenced.
*> If SORT = 'S', SELCTG is used to select eigenvalues to sort
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEeigen
*
$ VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK,
$ LIWORK, BWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SENSE, SORT
SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
$ LDQ, Z, LDZ, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.6.1) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2015
EXTERNAL ILAENV, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL DGGHRD, DLARTG, DLASET, DORM22, DROT, XERBLA
+ EXTERNAL DGGHRD, DLARTG, DLASET, DORM22, DROT, DGEMM,
+ $ DGEMV, DTRMV, DLACPY, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, MAX
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHERcomputational
*
SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS,
$ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDV, LWORK, M, MV, N, NSWEEP
EXTERNAL IDAMAX, LSAME, DDOT, DNRM2
* ..
* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, DSWAP
+ EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, DSWAP,
+ $ XERBLA
* ..
* .. Executable Statements ..
*
SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
$ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
EXTERNAL IDAMAX, LSAME, DDOT, DNRM2
* ..
* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, DSWAP
+ EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, DSWAP,
+ $ XERBLA
* ..
* .. Executable Statements ..
*
* LOGICAL FUNCTION DISNAN( DIN )
*
* .. Scalar Arguments ..
-* DOUBLE PRECISION DIN
+* DOUBLE PRECISION, INTENT(IN) :: DIN
* ..
*
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
LOGICAL FUNCTION DISNAN( DIN )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
- DOUBLE PRECISION DIN
+ DOUBLE PRECISION, INTENT(IN) :: DIN
* ..
*
* =====================================================================
*>
*> \param[in] AB
*> \verbatim
-*> AB is DOUBLE PRECISION array of DIMENSION ( LDAB, n )
+*> AB is DOUBLE PRECISION array, dimension ( LDAB, n )
*> Before entry, the leading m by n part of the array AB must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGBcomputational
*
SUBROUTINE DLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
$ INCX, BETA, Y, INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA, BETA
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension
-*> (LDY,NRHS)
+*> Y is DOUBLE PRECISION array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by DGBTRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGBcomputational
*
$ Y_TAIL, RCOND, ITHRESH, RTHRESH,
$ DZ_UB, IGNORE_CWISE, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDAB, LDAFB, LDB, LDY, N, KL, KU, NRHS,
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n )
+*> A is DOUBLE PRECISION array, dimension ( LDA, n )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION
-*> Array of DIMENSION at least
+*> Y is DOUBLE PRECISION array,
+*> dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
SUBROUTINE DLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
$ Y, INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA, BETA
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension
-*> (LDY,NRHS)
+*> Y is DOUBLE PRECISION array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by DGETRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERRS_N
*> \verbatim
-*> ERRS_N is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERRS_N is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERRS_C
*> \verbatim
-*> ERRS_C is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERRS_C is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
$ Y_TAIL, RCOND, ITHRESH, RTHRESH,
$ DZ_UB, IGNORE_CWISE, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension
-*> (LDY,NRHS)
+*> Y is DOUBLE PRECISION array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by DPOTRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doublePOcomputational
*
$ RTHRESH, DZ_UB, IGNORE_CWISE,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*> A is DOUBLE PRECISION array, dimension ( LDA, n ).
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleSYcomputational
*
SUBROUTINE DLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
$ INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA, BETA
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is DOUBLE PRECISION array, dimension
-*> (LDY,NRHS)
+*> Y is DOUBLE PRECISION array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by DSYTRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleSYcomputational
*
$ RTHRESH, DZ_UB, IGNORE_CWISE,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is DOUBLE PRECISION array dimension (NB)
+*> TAUQ is DOUBLE PRECISION array, dimension (NB)
*> The scalar factors of the elementary reflectors which
*> represent the orthogonal matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERauxiliary
*
SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
$ LDY )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, LDX, LDY, M, N, NB
*>
*> \param[in] Q2
*> \verbatim
-*> Q2 is DOUBLE PRECISION array, dimension (LDQ2, N)
+*> Q2 is DOUBLE PRECISION array, dimension (LDQ2*N)
*> The first K columns of this matrix contain the non-deflated
*> eigenvectors for the split problem.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX,
$ CTOT, W, S, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDQ, N, N1
* LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 )
*
* .. Scalar Arguments ..
-* DOUBLE PRECISION DIN1, DIN2
+* DOUBLE PRECISION, INTENT(IN) :: DIN1, DIN2
* ..
*
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
LOGICAL FUNCTION DLAISNAN( DIN1, DIN2 )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
- DOUBLE PRECISION DIN1, DIN2
+ DOUBLE PRECISION, INTENT(IN) :: DIN1, DIN2
* ..
*
* =====================================================================
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array.
-*> The dimension must be at least N.
+*> WORK is DOUBLE PRECISION array, dimension (N)
*> \endverbatim
*>
*> \param[out] IWORK
*> \verbatim
-*> IWORK is INTEGER array.
-*> The dimension must be at least 3 * N
+*> IWORK is INTEGER array, dimension (3*N)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
$ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK,
$ IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
*> \param[in] M
*> \verbatim
*> M is INTEGER
-*> The number of rows of the matrix A. M >=0.
+*> The number of rows of the matrix C. M >=0.
*> \endverbatim
*>
*> \param[in] N
*>
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,K)
+*> A is DOUBLE PRECISION array, dimension
+*> (LDA,M) if SIDE = 'L',
+*> (LDA,N) if SIDE = 'R'
*> The i-th row must contain the vector which defines the blocked
*> elementary reflector H(i), for i = 1,2,...,k, as returned by
*> DLASWLQ in the first k rows of its array argument A.
SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
*> N >= NB >= 1.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,K)
*> The i-th column must contain the vector which defines the
SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION X, Y
* ..
* .. Local Scalars ..
DOUBLE PRECISION W, XABS, YABS, Z
+ LOGICAL X_IS_NAN, Y_IS_NAN
+* ..
+* .. External Functions ..
+ LOGICAL DISNAN
+ EXTERNAL DISNAN
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT
* ..
* .. Executable Statements ..
*
- XABS = ABS( X )
- YABS = ABS( Y )
- W = MAX( XABS, YABS )
- Z = MIN( XABS, YABS )
- IF( Z.EQ.ZERO ) THEN
- DLAPY2 = W
- ELSE
- DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
+ X_IS_NAN = DISNAN( X )
+ Y_IS_NAN = DISNAN( Y )
+ IF ( X_IS_NAN ) DLAPY2 = X
+ IF ( Y_IS_NAN ) DLAPY2 = Y
+*
+ IF ( .NOT.( X_IS_NAN.OR.Y_IS_NAN ) ) THEN
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ W = MAX( XABS, YABS )
+ Z = MIN( XABS, YABS )
+ IF( Z.EQ.ZERO ) THEN
+ DLAPY2 = W
+ ELSE
+ DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
+ END IF
END IF
RETURN
*
*
*> \param[in] N
*> \verbatim
-*> N is integer
+*> N is INTEGER
*> Order of the matrix H. N must be either 2 or 3.
*> \endverbatim
*>
*> \param[in] H
*> \verbatim
-*> H is DOUBLE PRECISION array of dimension (LDH,N)
+*> H is DOUBLE PRECISION array, dimension (LDH,N)
*> The 2-by-2 or 3-by-3 matrix H in (*).
*> \endverbatim
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> The leading dimension of H as declared in
*> the calling procedure. LDH.GE.N
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
-*> V is DOUBLE PRECISION array of dimension N
+*> V is DOUBLE PRECISION array, dimension (N)
*> A scalar multiple of the first column of the
*> matrix K in (*).
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERauxiliary
*
* =====================================================================
SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION SI1, SI2, SR1, SR2
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> Leading dimension of H just as declared in the calling
*> subroutine. N .LE. LDH
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer
+*> LDZ is INTEGER
*> The leading dimension of Z just as declared in the
*> calling subroutine. 1 .LE. LDZ.
*> \endverbatim
*>
*> \param[out] NS
*> \verbatim
-*> NS is integer
+*> NS is INTEGER
*> The number of unconverged (ie approximate) eigenvalues
*> returned in SR and SI that may be used as shifts by the
*> calling subroutine.
*>
*> \param[out] ND
*> \verbatim
-*> ND is integer
+*> ND is INTEGER
*> The number of converged eigenvalues uncovered by this
*> subroutine.
*> \endverbatim
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> The leading dimension of V just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> The number of columns of T. NH.GE.NW.
*> \endverbatim
*>
*>
*> \param[in] LDT
*> \verbatim
-*> LDT is integer
+*> LDT is INTEGER
*> The leading dimension of T just as declared in the
*> calling subroutine. NW .LE. LDT
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer
+*> NV is INTEGER
*> The number of rows of work array WV available for
*> workspace. NV.GE.NW.
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer
+*> LDWV is INTEGER
*> The leading dimension of W just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
-*> LWORK is integer
+*> LWORK is INTEGER
*> The dimension of the work array WORK. LWORK = 2*NW
*> suffices, but greater efficiency may result from larger
*> values of LWORK.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERauxiliary
*
$ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
$ LDT, NV, WV, LDWV, WORK, LWORK )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> Leading dimension of H just as declared in the calling
*> subroutine. N .LE. LDH
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer
+*> LDZ is INTEGER
*> The leading dimension of Z just as declared in the
*> calling subroutine. 1 .LE. LDZ.
*> \endverbatim
*>
*> \param[out] NS
*> \verbatim
-*> NS is integer
+*> NS is INTEGER
*> The number of unconverged (ie approximate) eigenvalues
*> returned in SR and SI that may be used as shifts by the
*> calling subroutine.
*>
*> \param[out] ND
*> \verbatim
-*> ND is integer
+*> ND is INTEGER
*> The number of converged eigenvalues uncovered by this
*> subroutine.
*> \endverbatim
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> The leading dimension of V just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> The number of columns of T. NH.GE.NW.
*> \endverbatim
*>
*>
*> \param[in] LDT
*> \verbatim
-*> LDT is integer
+*> LDT is INTEGER
*> The leading dimension of T just as declared in the
*> calling subroutine. NW .LE. LDT
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer
+*> NV is INTEGER
*> The number of rows of work array WV available for
*> workspace. NV.GE.NW.
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer
+*> LDWV is INTEGER
*> The leading dimension of W just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
-*> LWORK is integer
+*> LWORK is INTEGER
*> The dimension of the work array WORK. LWORK = 2*NW
*> suffices, but greater efficiency may result from larger
*> values of LWORK.
$ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
$ LDT, NV, WV, LDWV, WORK, LWORK )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
*> \param[in] WANTT
*> \verbatim
-*> WANTT is logical scalar
+*> WANTT is LOGICAL
*> WANTT = .true. if the quasi-triangular Schur factor
*> is being computed. WANTT is set to .false. otherwise.
*> \endverbatim
*>
*> \param[in] WANTZ
*> \verbatim
-*> WANTZ is logical scalar
+*> WANTZ is LOGICAL
*> WANTZ = .true. if the orthogonal Schur factor is being
*> computed. WANTZ is set to .false. otherwise.
*> \endverbatim
*>
*> \param[in] KACC22
*> \verbatim
-*> KACC22 is integer with value 0, 1, or 2.
+*> KACC22 is INTEGER with value 0, 1, or 2.
*> Specifies the computation mode of far-from-diagonal
*> orthogonal updates.
*> = 0: DLAQR5 does not accumulate reflections and does not
*>
*> \param[in] N
*> \verbatim
-*> N is integer scalar
+*> N is INTEGER
*> N is the order of the Hessenberg matrix H upon which this
*> subroutine operates.
*> \endverbatim
*>
*> \param[in] KTOP
*> \verbatim
-*> KTOP is integer scalar
+*> KTOP is INTEGER
*> \endverbatim
*>
*> \param[in] KBOT
*> \verbatim
-*> KBOT is integer scalar
+*> KBOT is INTEGER
*> These are the first and last rows and columns of an
*> isolated diagonal block upon which the QR sweep is to be
*> applied. It is assumed without a check that
*>
*> \param[in] NSHFTS
*> \verbatim
-*> NSHFTS is integer scalar
+*> NSHFTS is INTEGER
*> NSHFTS gives the number of simultaneous shifts. NSHFTS
*> must be positive and even.
*> \endverbatim
*>
*> \param[in,out] SR
*> \verbatim
-*> SR is DOUBLE PRECISION array of size (NSHFTS)
+*> SR is DOUBLE PRECISION array, dimension (NSHFTS)
*> \endverbatim
*>
*> \param[in,out] SI
*> \verbatim
-*> SI is DOUBLE PRECISION array of size (NSHFTS)
+*> SI is DOUBLE PRECISION array, dimension (NSHFTS)
*> SR contains the real parts and SI contains the imaginary
*> parts of the NSHFTS shifts of origin that define the
*> multi-shift QR sweep. On output SR and SI may be
*>
*> \param[in,out] H
*> \verbatim
-*> H is DOUBLE PRECISION array of size (LDH,N)
+*> H is DOUBLE PRECISION array, dimension (LDH,N)
*> On input H contains a Hessenberg matrix. On output a
*> multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
*> to the isolated diagonal block in rows and columns KTOP
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer scalar
+*> LDH is INTEGER
*> LDH is the leading dimension of H just as declared in the
*> calling procedure. LDH.GE.MAX(1,N).
*> \endverbatim
*>
*> \param[in,out] Z
*> \verbatim
-*> Z is DOUBLE PRECISION array of size (LDZ,IHIZ)
+*> Z is DOUBLE PRECISION array, dimension (LDZ,IHIZ)
*> If WANTZ = .TRUE., then the QR Sweep orthogonal
*> similarity transformation is accumulated into
*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right.
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer scalar
+*> LDZ is INTEGER
*> LDA is the leading dimension of Z just as declared in
*> the calling procedure. LDZ.GE.N.
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
-*> V is DOUBLE PRECISION array of size (LDV,NSHFTS/2)
+*> V is DOUBLE PRECISION array, dimension (LDV,NSHFTS/2)
*> \endverbatim
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> LDV is the leading dimension of V as declared in the
*> calling procedure. LDV.GE.3.
*> \endverbatim
*>
*> \param[out] U
*> \verbatim
-*> U is DOUBLE PRECISION array of size
-*> (LDU,3*NSHFTS-3)
+*> U is DOUBLE PRECISION array, dimension (LDU,3*NSHFTS-3)
*> \endverbatim
*>
*> \param[in] LDU
*> \verbatim
-*> LDU is integer scalar
+*> LDU is INTEGER
*> LDU is the leading dimension of U just as declared in the
*> in the calling subroutine. LDU.GE.3*NSHFTS-3.
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> NH is the number of columns in array WH available for
*> workspace. NH.GE.1.
*> \endverbatim
*>
*> \param[out] WH
*> \verbatim
-*> WH is DOUBLE PRECISION array of size (LDWH,NH)
+*> WH is DOUBLE PRECISION array, dimension (LDWH,NH)
*> \endverbatim
*>
*> \param[in] LDWH
*> \verbatim
-*> LDWH is integer scalar
+*> LDWH is INTEGER
*> Leading dimension of WH just as declared in the
*> calling procedure. LDWH.GE.3*NSHFTS-3.
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer scalar
+*> NV is INTEGER
*> NV is the number of rows in WV agailable for workspace.
*> NV.GE.1.
*> \endverbatim
*>
*> \param[out] WV
*> \verbatim
-*> WV is DOUBLE PRECISION array of size
-*> (LDWV,3*NSHFTS-3)
+*> WV is DOUBLE PRECISION array, dimension (LDWV,3*NSHFTS-3)
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer scalar
+*> LDWV is INTEGER
*> LDWV is the leading dimension of WV as declared in the
*> in the calling subroutine. LDWV.GE.NV.
*> \endverbatim
$ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
$ LDU, NV, WV, LDWV, NH, WH, LDWH )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHERauxiliary
*
* =====================================================================
SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX, N
CALL DSCAL( N-1, RSAFMN, X, INCX )
BETA = BETA*RSAFMN
ALPHA = ALPHA*RSAFMN
- IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000 )
+ IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) )
$ GO TO 10
*
* New BETA is at most 1, at least SAFMIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHERauxiliary
*
* =====================================================================
SUBROUTINE DLARFGP( N, ALPHA, X, INCX, TAU )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX, N
CALL DSCAL( N-1, BIGNUM, X, INCX )
BETA = BETA*BIGNUM
ALPHA = ALPHA*BIGNUM
- IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000)
+ IF( (ABS( BETA ).LT.SMLNUM) .AND. (KNT .LT. 20) )
$ GO TO 10
*
* New BETA is at most 1, at least SMLNUM
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
SUBROUTINE DLARRA( N, D, E, E2, SPLTOL, TNRM,
$ NSPLIT, ISPLIT, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, N, NSPLIT
* .. Executable Statements ..
*
INFO = 0
-
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
* Compute splitting points
NSPLIT = 1
IF(SPLTOL.LT.ZERO) THEN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
$ RTOL2, OFFSET, W, WGAP, WERR, WORK, IWORK,
$ PIVMIN, SPDIAM, TWIST, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IFIRST, ILAST, INFO, N, OFFSET, TWIST
*
INFO = 0
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
MAXITR = INT( ( LOG( SPDIAM+PIVMIN )-LOG( PIVMIN ) ) /
$ LOG( TWO ) ) + 2
MNWDTH = TWO * PIVMIN
SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
$ EIGCNT, LCNT, RCNT, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. Executable Statements ..
*
INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
LCNT = 0
RCNT = 0
EIGCNT = 0
$ M, W, WERR, WL, WU, IBLOCK, INDEXW,
$ WORK, IWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
INFO = 0
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
* Decode RANGE
*
IF( LSAME( RANGE, 'A' ) ) THEN
$ W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN,
$ WORK, IWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DLARNV, DLARRA, DLARRB, DLARRC, DLARRD,
- $ DLASQ2
+ $ DLASQ2, DLARRK
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN
*
INFO = 0
-
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
*
* Decode RANGE
*
$ SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA,
$ DPLUS, LPLUS, WORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. Executable Statements ..
*
INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
FACT = DBLE(2**KTRYMAX)
EPS = DLAMCH( 'Precision' )
SHIFT = 0
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
$ RTOL, OFFSET, W, WERR, WORK, IWORK,
$ PIVMIN, SPDIAM, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IFIRST, ILAST, INFO, N, OFFSET
*
INFO = 0
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
MAXITR = INT( ( LOG( SPDIAM+PIVMIN )-LOG( PIVMIN ) ) /
$ LOG( TWO ) ) + 2
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
SUBROUTINE DLARRK( N, IW, GL, GU,
$ D, E2, PIVMIN, RELTOL, W, WERR, INFO)
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, IW, N
* ..
* .. Executable Statements ..
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ INFO = 0
+ RETURN
+ END IF
+*
* Get machine constants
EPS = DLAMCH( 'P' )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE DLARRR( N, D, E, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER N, INFO
* ..
* .. Executable Statements ..
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ INFO = 0
+ RETURN
+ END IF
+*
* As a default, do NOT go for relative-accuracy preserving computations.
INFO = 1
*> \verbatim
*> VU is DOUBLE PRECISION
*> Upper bound of the interval that contains the desired
-*> eigenvalues. VL < VU. Needed to compute gaps on the left or right
-*> end of the extremal eigenvalues in the desired RANGE.
+*> eigenvalues. VL < VU.
+*> Note: VU is currently not used by this implementation of DLARRV, VU is
+*> passed to DLARRV because it could be used compute gaps on the right end
+*> of the extremal eigenvalues. However, with not much initial accuracy in
+*> LAMBDA and VU, the formula can lead to an overestimation of the right gap
+*> and thus to inadequately early RQI 'convergence'. This is currently
+*> prevented this by forcing a small right gap. And so it turns out that VU
+*> is currently not used by this implementation of DLARRV.
*> \endverbatim
*>
*> \param[in,out] D
$ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ,
$ WORK, IWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
* The first N entries of WORK are reserved for the eigenvalues
INDLD = N+1
INDLLD= 2*N+1
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup auxOTHERcomputational
*
* =====================================================================
SUBROUTINE DLARTGS( X, Y, SIGMA, CS, SN )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION CS, SIGMA, SN, X, Y
* .. Local Scalars ..
DOUBLE PRECISION R, S, THRESH, W, Z
* ..
+* .. External Subroutines ..
+ EXTERNAL DLARTGP
+* ..
* .. External Functions ..
DOUBLE PRECISION DLAMCH
EXTERNAL DLAMCH
*>
*> \param[out] U
*> \verbatim
-*> U is DOUBLE PRECISION array, dimension at least (LDQ, N)
+*> U is DOUBLE PRECISION array, dimension (LDU, N)
*> On exit, U contains the left singular vectors.
*> \endverbatim
*>
*>
*> \param[out] VT
*> \verbatim
-*> VT is DOUBLE PRECISION array, dimension at least (LDVT, M)
+*> VT is DOUBLE PRECISION array, dimension (LDVT, M)
*> On exit, VT**T contains the right singular vectors.
*> \endverbatim
*>
*>
*> \param[out] IWORK
*> \verbatim
-*> IWORK is INTEGER work array.
-*> Dimension must be at least (8 * N)
+*> IWORK is INTEGER array, dimension (8*N)
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION work array.
-*> Dimension must be at least (3 * M**2 + 2 * M)
+*> WORK is DOUBLE PRECISION array, dimension (3*M**2+2*M)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
$ WORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
*>
*> \param[out] IDXP
*> \verbatim
-*> IDXP is INTEGER array dimension(N)
+*> IDXP is INTEGER array, dimension(N)
*> This will contain the permutation used to place deflated
*> values of D at the end of the array. On output IDXP(2:K)
*> points to the nondeflated D-values and IDXP(K+1:N)
*>
*> \param[out] IDX
*> \verbatim
-*> IDX is INTEGER array dimension(N)
+*> IDX is INTEGER array, dimension(N)
*> This will contain the permutation used to sort the contents of
*> D into ascending order.
*> \endverbatim
*>
*> \param[out] IDXC
*> \verbatim
-*> IDXC is INTEGER array dimension(N)
+*> IDXC is INTEGER array, dimension(N)
*> This will contain the permutation used to arrange the columns
*> of the deflated U matrix into three groups: the first group
*> contains non-zero entries only at and above NL, the second
*>
*> \param[in,out] IDXQ
*> \verbatim
-*> IDXQ is INTEGER array dimension(N)
+*> IDXQ is INTEGER array, dimension(N)
*> This contains the permutation which separately sorts the two
*> sub-problems in D into ascending order. Note that entries in
*> the first hlaf of this permutation must first be moved one
*>
*> \param[out] COLTYP
*> \verbatim
-*> COLTYP is INTEGER array dimension(N)
+*> COLTYP is INTEGER array, dimension(N)
*> As workspace, this will contain a label which will indicate
*> which of the following types a column in the U2 matrix or a
*> row in the VT2 matrix is:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
$ LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX,
$ IDXC, IDXQ, COLTYP, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDU, LDU2, LDVT, LDVT2, NL, NR, SQRE
*>
*> \param[out] Q
*> \verbatim
-*> Q is DOUBLE PRECISION array,
-*> dimension at least (LDQ,K).
+*> Q is DOUBLE PRECISION array, dimension (LDQ,K)
*> \endverbatim
*>
*> \param[in] LDQ
*> The leading dimension of the array Q. LDQ >= K.
*> \endverbatim
*>
-*> \param[in] DSIGMA
+*> \param[in,out] DSIGMA
*> \verbatim
*> DSIGMA is DOUBLE PRECISION array, dimension(K)
*> The first K elements of this array contain the old roots
*> The leading dimension of the array U. LDU >= N.
*> \endverbatim
*>
-*> \param[in,out] U2
+*> \param[in] U2
*> \verbatim
*> U2 is DOUBLE PRECISION array, dimension (LDU2, N)
*> The first K columns of this matrix contain the non-deflated
*> type is any column which has been deflated.
*> \endverbatim
*>
-*> \param[in] Z
+*> \param[in,out] Z
*> \verbatim
*> Z is DOUBLE PRECISION array, dimension (K)
*> The first K elements of this array contain the components
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
$ LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z,
$ INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDQ, LDU, LDU2, LDVT, LDVT2, NL, NR,
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension at least 3 * K
+*> WORK is DOUBLE PRECISION array, dimension (3*K)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
SUBROUTINE DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR,
$ DSIGMA, WORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER ICOMPQ, INFO, K, LDDIFR
*>
*> \param[out] IWORK
*> \verbatim
-*> IWORK is INTEGER array.
-*> Dimension must be at least (7 * N).
+*> IWORK is INTEGER array, dimension (7*N)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
$ DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL,
$ PERM, GIVNUM, C, S, WORK, IWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE
SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
$ DN1, DN2, TAU, TTYPE, G )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
NP = NN - 9
ELSE
NP = NN - 2*PP
- B2 = Z( NP-2 )
GAM = DN1
IF( Z( NP-4 ) .GT. Z( NP-2 ) )
$ RETURN
*> IEEE is LOGICAL
*> Flag for IEEE or non IEEE arithmetic.
*> \endverbatim
-*
+*>
*> \param[in] EPS
*> \verbatim
*> EPS is DOUBLE PRECISION
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2,
$ DN, DNM1, DNM2, IEEE, EPS )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL IEEE
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,N)
*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and bleow the diagonal
+*> On exit, the elements on and below the diagonal
*> of the array contain the N-by-N lower triangular matrix L;
*> the elements above the diagonal represent Q by the rows
*> of blocked V (see Further Details).
SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
$ INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
*> \verbatim
*> IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
*> The vector of pivot indices. Only the elements in positions
-*> K1 through K1+(K2-K1)*INCX of IPIV are accessed.
-*> IPIV(K) = L implies rows K and L are to be interchanged.
+*> K1 through K1+(K2-K1)*abs(INCX) of IPIV are accessed.
+*> IPIV(K1+(K-K1)*abs(INCX)) = L implies rows K and L are to be
+*> interchanged.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
-*> The increment between successive values of IPIV. If IPIV
+*> The increment between successive values of IPIV. If INCX
*> is negative, the pivots are applied in reverse order.
*> \endverbatim
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERauxiliary
*
* =====================================================================
SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INCX, K1, K2, LDA, N
* ..
* .. Executable Statements ..
*
-* Interchange row I with row IPIV(I) for each of rows K1 through K2.
+* Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
+* K1 through K2.
*
IF( INCX.GT.0 ) THEN
IX0 = K1
* ===========
*
* SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-* H, LDH, WORK, INFO )
+* H, LDH, WORK )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
-* INTEGER J1, M, NB, LDA, LDH, INFO
+* INTEGER J1, M, NB, LDA, LDH
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[out] IPIV
*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
+*> IPIV is INTEGER array, dimension (M)
*> Details of the row and column interchanges,
*> the row and column k were interchanged with the row and
*> column IPIV(k).
*> WORK is DOUBLE PRECISION workspace, dimension (M).
*> \endverbatim
*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
*
* Authors:
* ========
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
* =====================================================================
SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
- $ H, LDH, WORK, INFO )
+ $ H, LDH, WORK )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
* .. Scalar Arguments ..
CHARACTER UPLO
- INTEGER M, NB, J1, LDA, LDH, INFO
+ INTEGER M, NB, J1, LDA, LDH
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
*
* .. Local Scalars ..
- INTEGER J, K, K1, I1, I2
+ INTEGER J, K, K1, I1, I2, MJ
DOUBLE PRECISION PIV, ALPHA
* ..
* .. External Functions ..
EXTERNAL LSAME, ILAENV, IDAMAX
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL DGEMV, DAXPY, DCOPY, DSWAP, DSCAL, DLASET,
+ $ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
* ..
* .. Executable Statements ..
*
- INFO = 0
J = 1
*
* K1 is the first column of the panel to be factorized
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
-* H(J:N, J) := A(J, J:N) - H(J:N, 1:(J-1)) * L(J1:(J-1), J),
-* where H(J:N, J) has been initialized to be A(J, J:N)
+* H(J:M, J) := A(J, J:M) - H(J:M, 1:(J-1)) * L(J1:(J-1), J),
+* where H(J:M, J) has been initialized to be A(J, J:M)
*
IF( K.GT.2 ) THEN
*
* > for the rest of the columns, K is J+1, skipping only the
* first column
*
- CALL DGEMV( 'No transpose', M-J+1, J-K1,
+ CALL DGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( 1, J ), 1,
$ ONE, H( J, J ), 1 )
END IF
*
-* Copy H(i:n, i) into WORK
+* Copy H(i:M, i) into WORK
*
- CALL DCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL DCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
-* Compute WORK := WORK - L(J-1, J:N) * T(J-1,J),
-* where A(J-1, J) stores T(J-1, J) and A(J-2, J:N) stores U(J-1, J:N)
+* Compute WORK := WORK - L(J-1, J:M) * T(J-1,J),
+* where A(J-1, J) stores T(J-1, J) and A(J-2, J:M) stores U(J-1, J:M)
*
ALPHA = -A( K-1, J )
- CALL DAXPY( M-J+1, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
+ CALL DAXPY( MJ, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
*
IF( J.LT.M ) THEN
*
-* Compute WORK(2:N) = T(J, J) L(J, (J+1):N)
-* where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N)
+* Compute WORK(2:M) = T(J, J) L(J, (J+1):M)
+* where A(J, J) stores T(J, J) and A(J-1, (J+1):M) stores U(J, (J+1):M)
*
IF( K.GT.1 ) THEN
ALPHA = -A( K, J )
$ WORK( 2 ), 1 )
ENDIF
*
-* Find max(|WORK(2:n)|)
+* Find max(|WORK(2:M)|)
*
I2 = IDAMAX( M-J, WORK( 2 ), 1 ) + 1
PIV = WORK( I2 )
WORK( I2 ) = WORK( I1 )
WORK( I1 ) = PIV
*
-* Swap A(I1, I1+1:N) with A(I1+1:N, I2)
+* Swap A(I1, I1+1:M) with A(I1+1:M, I2)
*
I1 = I1+J-1
I2 = I2+J-1
CALL DSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA,
$ A( J1+I1, I2 ), 1 )
*
-* Swap A(I1, I2+1:N) with A(I2, I2+1:N)
+* Swap A(I1, I2+1:M) with A(I2, I2+1:M)
*
CALL DSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
$ A( J1+I2-1, I2+1 ), LDA )
* Set A(J, J+1) = T(J, J+1)
*
A( K, J+1 ) = WORK( 2 )
- IF( (A( K, J ).EQ.ZERO ) .AND.
- $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
- IF(INFO .EQ. 0) THEN
- INFO = J
- ENDIF
- END IF
*
IF( J.LT.NB ) THEN
*
-* Copy A(J+1:N, J+1) into H(J:N, J),
+* Copy A(J+1:M, J+1) into H(J:M, J),
*
CALL DCOPY( M-J, A( K+1, J+1 ), LDA,
$ H( J+1, J+1 ), 1 )
END IF
*
-* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
-* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
+* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
*
IF( A( K, J+1 ).NE.ZERO ) THEN
ALPHA = ONE / A( K, J+1 )
CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO,
$ A( K, J+2 ), LDA)
END IF
- ELSE
- IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 10
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
-* H(J:N, J) := A(J:N, J) - H(J:N, 1:(J-1)) * L(J, J1:(J-1))^T,
-* where H(J:N, J) has been initialized to be A(J:N, J)
+* H(J:M, J) := A(J:M, J) - H(J:M, 1:(J-1)) * L(J, J1:(J-1))^T,
+* where H(J:M, J) has been initialized to be A(J:M, J)
*
IF( K.GT.2 ) THEN
*
* > for the rest of the columns, K is J+1, skipping only the
* first column
*
- CALL DGEMV( 'No transpose', M-J+1, J-K1,
+ CALL DGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( J, 1 ), LDA,
$ ONE, H( J, J ), 1 )
END IF
*
-* Copy H(J:N, J) into WORK
+* Copy H(J:M, J) into WORK
*
- CALL DCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL DCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
-* Compute WORK := WORK - L(J:N, J-1) * T(J-1,J),
+* Compute WORK := WORK - L(J:M, J-1) * T(J-1,J),
* where A(J-1, J) = T(J-1, J) and A(J, J-2) = L(J, J-1)
*
ALPHA = -A( J, K-1 )
- CALL DAXPY( M-J+1, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
+ CALL DAXPY( MJ, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
*
IF( J.LT.M ) THEN
*
-* Compute WORK(2:N) = T(J, J) L((J+1):N, J)
-* where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J)
+* Compute WORK(2:M) = T(J, J) L((J+1):M, J)
+* where A(J, J) = T(J, J) and A((J+1):M, J-1) = L((J+1):M, J)
*
IF( K.GT.1 ) THEN
ALPHA = -A( J, K )
$ WORK( 2 ), 1 )
ENDIF
*
-* Find max(|WORK(2:n)|)
+* Find max(|WORK(2:M)|)
*
I2 = IDAMAX( M-J, WORK( 2 ), 1 ) + 1
PIV = WORK( I2 )
WORK( I2 ) = WORK( I1 )
WORK( I1 ) = PIV
*
-* Swap A(I1+1:N, I1) with A(I2, I1+1:N)
+* Swap A(I1+1:M, I1) with A(I2, I1+1:M)
*
I1 = I1+J-1
I2 = I2+J-1
CALL DSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1,
$ A( I2, J1+I1 ), LDA )
*
-* Swap A(I2+1:N, I1) with A(I2+1:N, I2)
+* Swap A(I2+1:M, I1) with A(I2+1:M, I2)
*
CALL DSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
$ A( I2+1, J1+I2-1 ), 1 )
* Set A(J+1, J) = T(J+1, J)
*
A( J+1, K ) = WORK( 2 )
- IF( (A( J, K ).EQ.ZERO) .AND.
- $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
- IF (INFO .EQ. 0)
- $ INFO = J
- END IF
*
IF( J.LT.NB ) THEN
*
-* Copy A(J+1:N, J+1) into H(J+1:N, J),
+* Copy A(J+1:M, J+1) into H(J+1:M, J),
*
CALL DCOPY( M-J, A( J+1, K+1 ), 1,
$ H( J+1, J+1 ), 1 )
END IF
*
-* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
-* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
+* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
*
IF( A( J+1, K ).NE.ZERO ) THEN
ALPHA = ONE / A( J+1, K )
CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO,
$ A( J+2, K ), LDA )
END IF
- ELSE
- IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 30
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
$ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE DORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
$ LDQ2, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
$ LDQ2, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*>
*> \param[out] U1
*> \verbatim
-*> U1 is DOUBLE PRECISION array, dimension (P)
+*> U1 is DOUBLE PRECISION array, dimension (LDU1,P)
*> If JOBU1 = 'Y', U1 contains the P-by-P orthogonal matrix U1.
*> \endverbatim
*>
*>
*> \param[out] U2
*> \verbatim
-*> U2 is DOUBLE PRECISION array, dimension (M-P)
+*> U2 is DOUBLE PRECISION array, dimension (LDU2,M-P)
*> If JOBU2 = 'Y', U2 contains the (M-P)-by-(M-P) orthogonal
*> matrix U2.
*> \endverbatim
*>
*> \param[out] V1T
*> \verbatim
-*> V1T is DOUBLE PRECISION array, dimension (Q)
+*> V1T is DOUBLE PRECISION array, dimension (LDV1T,Q)
*> If JOBV1T = 'Y', V1T contains the Q-by-Q matrix orthogonal
*> matrix V1**T.
*> \endverbatim
*>
*> \param[out] V2T
*> \verbatim
-*> V2T is DOUBLE PRECISION array, dimension (M-Q)
+*> V2T is DOUBLE PRECISION array, dimension (LDV2T,M-Q)
*> If JOBV2T = 'Y', V2T contains the (M-Q)-by-(M-Q) orthogonal
*> matrix V2**T.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
$ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
$ LDV2T, WORK, LWORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, SIGNS, TRANS
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
*> N2-by-N2 upper triangular matrix.
*> \endverbatim
*
-* Arguments
-* =========
+* Arguments:
+* ==========
*
*> \param[in] SIDE
*> \verbatim
SUBROUTINE DORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.6.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2015
*>
*> \param[in,out] AFP
*> \verbatim
-*> AFP is DOUBLE PRECISION array, dimension
-*> (N*(N+1)/2)
+*> AFP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
*> If FACT = 'F', then AFP is an input argument and on entry
*> contains the triangular factor U or L from the Cholesky
*> factorization A = U**T*U or A = L*L**T, in the same storage
SUBROUTINE DPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB,
$ X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHERauxiliary
*
* =====================================================================
SUBROUTINE DRSCL( N, SA, SX, INCX )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX, N
EXTERNAL DLAMCH
* ..
* .. External Subroutines ..
- EXTERNAL DSCAL
+ EXTERNAL DSCAL, DLABAD
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS
* Arguments:
* ==========
*
-*> @param[in] n
-*> The order of the matrix A.
-*>
-*> @param[in] nb
-*> The size of the band.
-*>
-*> @param[in, out] A
-*> A pointer to the matrix A.
-*>
-*> @param[in] lda
-*> The leading dimension of the matrix A.
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> \endverbatim
*>
-*> @param[out] V
-*> DOUBLE PRECISION array, dimension 2*n if eigenvalues only are
-*> requested or to be queried for vectors.
+*> \param[in] WANTZ
+*> \verbatim
+*> WANTZ is LOGICAL which indicate if Eigenvalue are requested or both
+*> Eigenvalue/Eigenvectors.
+*> \endverbatim
*>
-*> @param[out] TAU
-*> DOUBLE PRECISION array, dimension (2*n).
-*> The scalar factors of the Householder reflectors are stored
-*> in this array.
+*> \param[in] TTYPE
+*> \verbatim
+*> TTYPE is INTEGER
+*> \endverbatim
*>
-*> @param[in] st
+*> \param[in] ST
+*> \verbatim
+*> ST is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] ed
+*> \param[in] ED
+*> \verbatim
+*> ED is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] sweep
+*> \param[in] SWEEP
+*> \verbatim
+*> SWEEP is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] Vblksiz
-*> internal parameter for indices.
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER. The order of the matrix A.
+*> \endverbatim
*>
-*> @param[in] wantz
-*> logical which indicate if Eigenvalue are requested or both
-*> Eigenvalue/Eigenvectors.
+*> \param[in] NB
+*> \verbatim
+*> NB is INTEGER. The size of the band.
+*> \endverbatim
+*>
+*> \param[in] IB
+*> \verbatim
+*> IB is INTEGER.
+*> \endverbatim
+*>
+*> \param[in, out] A
+*> \verbatim
+*> A is DOUBLE PRECISION array. A pointer to the matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER. The leading dimension of the matrix A.
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*> V is DOUBLE PRECISION array, dimension 2*n if eigenvalues only are
+*> requested or to be queried for vectors.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is DOUBLE PRECISION array, dimension (2*n).
+*> The scalar factors of the Householder reflectors are stored
+*> in this array.
+*> \endverbatim
+*>
+*> \param[in] LDVT
+*> \verbatim
+*> LDVT is INTEGER.
+*> \endverbatim
*>
-*> @param[in] work
-*> Workspace of size nb.
+*> \param[in] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION array. Workspace of size nb.
+*> \endverbatim
*>
*> \par Further Details:
* =====================
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHEReigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, DLANSB
- EXTERNAL LSAME, DLAMCH, DLANSB, ILAENV
+ EXTERNAL LSAME, DLAMCH, DLANSB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DLASCL, DSCAL, DSTEQR, DSTERF, XERBLA,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- IB = ILAENV( 18, 'DSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
ENDIF
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHEReigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, DLANSB
- EXTERNAL LSAME, DLAMCH, DLANSB, ILAENV
+ EXTERNAL LSAME, DLAMCH, DLANSB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DGEMM, DLACPY, DLASCL, DSCAL, DSTEDC,
LIWMIN = 1
LWMIN = 1
ELSE
- IB = ILAENV( 18, 'DSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
IF( WANTZ ) THEN
LIWMIN = 3 + 5*N
LWMIN = 1 + 5*N + 2*N**2
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, DLANSB
- EXTERNAL LSAME, DLAMCH, DLANSB, ILAENV
+ EXTERNAL LSAME, DLAMCH, DLANSB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DGEMV, DLACPY, DLASCL, DSCAL,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- IB = ILAENV( 18, 'DSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = 2*N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
ENDIF
SUBROUTINE DSGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK,
$ SWORK, ITER, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
DOUBLE PRECISION ANRM, CTE, EPS, RNRM, XNRM
*
* .. External Subroutines ..
- EXTERNAL DAXPY, DGEMM, DLACPY, DLAG2S, SLAG2D, SGETRF,
- $ SGETRS, XERBLA
+ EXTERNAL DAXPY, DGEMM, DLACPY, DLAG2S, DGETRF, DGETRS,
+ $ SGETRF, SGETRS, SLAG2D, XERBLA
* ..
* .. External Functions ..
INTEGER IDAMAX
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (LWORK)
+*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the required LWORK.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHEReigen
*
SUBROUTINE DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
$ IWORK, LIWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension
-*> (N*(N+1)/2)
+*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
*> On entry, the upper or lower triangle of the symmetric matrix
*> A, packed columnwise in a linear array. The j-th column of A
*> is stored in the array AP as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHEReigen
*
SUBROUTINE DSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
$ INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK,
$ SWORK, ITER, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
* .. External Subroutines ..
EXTERNAL DAXPY, DSYMM, DLACPY, DLAT2S, DLAG2S, SLAG2D,
- $ SPOTRF, SPOTRS, XERBLA
+ $ SPOTRF, SPOTRS, DPOTRF, DPOTRS, XERBLA
* ..
* .. External Functions ..
INTEGER IDAMAX
*>
*> \param[in,out] AFP
*> \verbatim
-*> AFP is DOUBLE PRECISION array, dimension
-*> (N*(N+1)/2)
+*> AFP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
*> If FACT = 'F', then AFP is an input argument and on entry
*> contains the block diagonal matrix D and the multipliers used
*> to obtain the factor U or L from the factorization
SUBROUTINE DSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X,
$ LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (LWORK)
+*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER COMPZ
*>
*> \param[out] ISUPPZ
*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
+*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
*> The support of the eigenvectors in Z, i.e., the indices
*> indicating the nonzero elements in Z. The i-th computed eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
$ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[out] ISUPPZ
*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
+*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
*> The support of the eigenvectors in Z, i.e., the indices
*> indicating the nonzero elements in Z. The i-th computed eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
$ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK,
$ IWORK, LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleSYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE DSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
$ WORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* Definition:
* ===========
*
-* SUBROUTINE DSYCONVF( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+* SUBROUTINE DSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE DSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO, WAY
* Definition:
* ===========
*
-* SUBROUTINE DSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+* SUBROUTINE DSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE DSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
* =====================================================================
SUBROUTINE DSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, N
EXTERNAL DLAMCH, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL DLASSQ
+ EXTERNAL DLASSQ, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, INT, LOG, MAX, MIN, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY
+ EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DLASCL, DORGTR, DSCAL, DSTEQR, DSTERF,
END IF
*
IF( INFO.EQ.0 ) THEN
- KD = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = 2*N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV
+ EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DLACPY, DLASCL, DORMTR, DSCAL, DSTEDC, DSTERF,
LIWMIN = 1
LWMIN = 1
ELSE
- KD = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ,
+ $ N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
IF( WANTZ ) THEN
LIWMIN = 3 + 5*N
LWMIN = 1 + 6*N + 2*N**2
*>
*> Note 1 : DSYEVR calls DSTEMR when the full spectrum is requested
*> on machines which conform to the ieee-754 floating point standard.
-*> DSYEVR calls DSTEBZ and SSTEIN on non-ieee machines and
+*> DSYEVR calls DSTEBZ and DSTEIN on non-ieee machines and
*> when partial spectrum requests are made.
*>
*> Normal execution of DSTEMR may create NaNs and infinities and
$ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
$ IWORK, LIWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV, ILAENV2STAGE
DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY
+ EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DORMTR, DSCAL, DSTEBZ, DSTEMR, DSTEIN,
*
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
*
- KD = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD )
LIWMIN = MAX( 1, 10*N )
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, DLANSY
- EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY
+ EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DLACPY, DORGTR, DORMTR, DSCAL, DSTEBZ,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- KD = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ,
+ $ N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = MAX( 8*N, 3*N + LHTRD + LWTRD )
WORK( 1 ) = LWMIN
END IF
*> positive definite.
*> This routine use the 2stage technique for the reduction to tridiagonal
*> which showed higher performance on recent architecture and for large
-* sizes N>2000.
+*> sizes N>2000.
*> \endverbatim
*
* Arguments:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ INTEGER ILAENV2STAGE
+ EXTERNAL LSAME, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DPOTRF, DSYGST, DTRMM, DTRSM, XERBLA,
END IF
*
IF( INFO.EQ.0 ) THEN
- KD = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = 2*N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
-*
-* @precisions fortran d -> z c
+*> \date November 2017
*
*> \ingroup doubleSYsolve
*
SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL ILAENV, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, DSYTRF, DSYTRS, DSYTRS2
+ EXTERNAL XERBLA, DSYTRF_AA, DSYTRS_AA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief <b> DSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+* @generated from SRC/chesv_aa_2stage.f, fortran c -> d, Tue Oct 31 11:22:31 2017
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYSV_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsysv_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsysv_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsysv_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+* IPIV, IPIV2, B, LDB, WORK, LWORK,
+* INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* DOUBLE PRECISION A( LDA, * ), TB( * ), B( LDB, *), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DSYSV_AA_2STAGE computes the solution to a real system of
+*> linear equations
+*> A * X = B,
+*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+*> matrices.
+*>
+*> Aasen's 2-stage algorithm is used to factor A as
+*> A = U * T * U**T, if UPLO = 'U', or
+*> A = L * T * L**T, if UPLO = 'L',
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is symmetric and band. The matrix T is
+*> then LU-factored with partial pivoting. The factored form of A
+*> is then used to solve the system of equations A * X = B.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (LDA,N)
+*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is DOUBLE PRECISION array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup doubleSYsolve
+*
+* =====================================================================
+ SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, WORK, LWORK,
+ $ INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LDB, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER LWKOPT
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DSYTRF_AA_2STAGE, DSYTRS_AA_2STAGE,
+ $ XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
+ $ IPIV2, WORK, -1, INFO )
+ LWKOPT = INT( WORK(1) )
+ IF( LTB.LT.INT( TB(1) ) .AND. .NOT.TQUERY ) THEN
+ INFO = -7
+ ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.WQUERY ) THEN
+ INFO = -13
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DSYSV_AA_2STAGE', -INFO )
+ RETURN
+ ELSE IF( WQUERY .OR. TQUERY ) THEN
+ RETURN
+ END IF
+*
+*
+* Compute the factorization A = U*T*U**T or A = L*T*L**T.
+*
+ CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
+ $ WORK, LWORK, INFO )
+ IF( INFO.EQ.0 ) THEN
+*
+* Solve the system A*X = B, overwriting B with X.
+*
+ CALL DSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, B, LDB, INFO )
+*
+ END IF
+*
+ WORK( 1 ) = LWKOPT
+*
+ RETURN
+*
+* End of DSYSV_AA_2STAGE
+*
+ END
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension LWORK.
+*> WORK is DOUBLE PRECISION array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER VECT, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ INTEGER ILAENV2STAGE
+ EXTERNAL LSAME, ILAENV2STAGE
* ..
* .. Executable Statements ..
*
*
* Determine the block size, the workspace size and the hous size.
*
- KD = ILAENV( 17, 'DSYTRD_2STAGE', VECT, N, -1, -1, -1 )
- IB = ILAENV( 18, 'DSYTRD_2STAGE', VECT, N, KD, -1, -1 )
- LHMIN = ILAENV( 19, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
- LWMIN = ILAENV( 20, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', VECT, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', VECT, N, KD, -1, -1 )
+ LHMIN = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
+ LWMIN = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
* WRITE(*,*),'DSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
* $ LHMIN, LWMIN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup real16OTHERcomputational
*
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER STAGE1, UPLO, VECT
$ SIDEV, SIZETAU, LDV, LHMIN, LWMIN
* ..
* .. External Subroutines ..
- EXTERNAL DSB2ST_KERNELS, DLACPY, DLASET
+ EXTERNAL DSB2ST_KERNELS, DLACPY, DLASET, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MIN, MAX, CEILING, REAL
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension LWORK.
+*> WORK is DOUBLE PRECISION array, dimension (LWORK)
*> On exit, if INFO = 0, or if LWORK=-1,
*> WORK(1) returns the size of LWORK.
*> \endverbatim
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK which should be calculated
-* by a workspace query. LWORK = MAX(1, LWORK_QUERY)
+*> by a workspace query. LWORK = MAX(1, LWORK_QUERY)
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
*>
*> where tau is a real scalar, and v is a real vector with
*> v(kd+1:i) = 0 and v(i+kd+1) = 1; v(i+kd+2:n) is stored on exit in
-* A(i+kd+2:n,i), and tau in TAU(i).
+*> A(i+kd+2:n,i), and tau in TAU(i).
*>
*> The contents of A on exit are illustrated by the following examples
*> with n = 5:
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
$ TPOS, WPOS, S2POS, S1POS
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, DSYR2K, DSYMM, DGEMM,
+ EXTERNAL XERBLA, DSYR2K, DSYMM, DGEMM, DCOPY,
$ DLARFT, DGELQF, DGEQRF, DLASET
* ..
* .. Intrinsic Functions ..
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
* =====================================================================
SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
*
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
- INTEGER J, LWKOPT, IINFO
+ INTEGER J, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
DOUBLE PRECISION ALPHA
* ..
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL DLASYF_AA, DGEMM, DGEMV, DSCAL, DCOPY, DSWAP,
+ $ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*
* Determine the block size
*
- NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 )
+ NB = ILAENV( 1, 'DSYTRF_AA', UPLO, N, -1, -1, -1 )
*
* Test the input parameters.
*
ENDIF
IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN
- IF ( A( 1, 1 ).EQ.ZERO ) THEN
- INFO = 1
- END IF
RETURN
END IF
*
-* Adjubst block size based on the workspace size
+* Adjust block size based on the workspace size
*
IF( LWORK.LT.((1+NB)*N) ) THEN
NB = ( LWORK-N ) / N
*
CALL DLASYF_AA( UPLO, 2-K1, N-J, JB,
$ A( MAX(1, J), J+1 ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
- $ IINFO )
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
*
CALL DLASYF_AA( UPLO, 2-K1, N-J, JB,
$ A( J+1, MAX(1, J) ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
--- /dev/null
+*> \brief \b DSYTRF_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYTRF_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrf_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrf_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrf_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+* IPIV2, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* DOUBLE PRECISION A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DSYTRF_AA_2STAGE computes the factorization of a real symmetric matrix A
+*> using the Aasen's algorithm. The form of the factorization is
+*>
+*> A = U*T*U**T or A = L*T*L**T
+*>
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is a symmetric band matrix with the
+*> bandwidth of NB (NB is internally selected and stored in TB( 1 ), and T is
+*> LU factorized with partial pivoting).
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (LDA,N)
+*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is DOUBLE PRECISION array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup doubleSYcomputational
+*
+* =====================================================================
+ SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, WORK, LWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ DOUBLE PRECISION A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER I, J, K, I1, I2, TD
+ INTEGER LDTB, NB, KB, JB, NT, IINFO
+ DOUBLE PRECISION PIV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, DCOPY, DLACGV, DLACPY,
+ $ DLASET, DGBTRF, DGEMM, DGETRF,
+ $ DSYGST, DSWAP, DTRSM
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN
+ INFO = -6
+ ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN
+ INFO = -10
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DSYTRF_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Answer the query
+*
+ NB = ILAENV( 1, 'DSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
+ IF( INFO.EQ.0 ) THEN
+ IF( TQUERY ) THEN
+ TB( 1 ) = (3*NB+1)*N
+ END IF
+ IF( WQUERY ) THEN
+ WORK( 1 ) = N*NB
+ END IF
+ END IF
+ IF( TQUERY .OR. WQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return
+*
+ IF ( N.EQ.0 ) THEN
+ RETURN
+ ENDIF
+*
+* Determine the number of the block size
+*
+ LDTB = LTB/N
+ IF( LDTB .LT. 3*NB+1 ) THEN
+ NB = (LDTB-1)/3
+ END IF
+ IF( LWORK .LT. NB*N ) THEN
+ NB = LWORK/N
+ END IF
+*
+* Determine the number of the block columns
+*
+ NT = (N+NB-1)/NB
+ TD = 2*NB
+ KB = MIN(NB, N)
+*
+* Initialize vectors/matrices
+*
+ DO J = 1, KB
+ IPIV( J ) = J
+ END DO
+*
+* Save NB
+*
+ TB( 1 ) = NB
+*
+ IF( UPPER ) THEN
+*
+* .....................................................
+* Factorize A as L*D*L**T using the upper triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I .EQ. 1 ) THEN
+* H(I,J) = T(I,I)*U(I,J) + T(I,I+1)*U(I+1,J)
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL DGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( (I-1)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*U(I-1,J) + T(I,I)*U(I,J) + T(I,I+1)*U(I+1,J)
+ IF( I .EQ. J-1) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL DGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (I-2)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL DLACPY( 'Upper', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = U(1:J,J)'*H(1:J)
+ CALL DGEMM( 'Transpose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -ONE, A( 1, J*NB+1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += U(J,J)'*T(J,J-1)*U(J-1,J)
+ CALL DGEMM( 'Transpose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ ONE, A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ ZERO, WORK( 1 ), N )
+ CALL DGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB,
+ $ -ONE, WORK( 1 ), N,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+ IF( J.GT.0 ) THEN
+ CALL DSYGST( 1, 'Upper', KB,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA, IINFO )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ $ = TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL DGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, KB,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL DGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB+KB,
+ $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL DGEMM( 'Transpose', 'NoTranspose',
+ $ NB, N-(J+1)*NB, J*NB,
+ $ -ONE, WORK( NB+1 ), N,
+ $ A( 1, (J+1)*NB+1 ), LDA,
+ $ ONE, A( J*NB+1, (J+1)*NB+1 ), LDA )
+ END IF
+*
+* Copy panel to workspace to call DGETRF
+*
+ DO K = 1, NB
+ CALL DCOPY( N-(J+1)*NB,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA,
+ $ WORK( 1+(K-1)*N ), 1 )
+ END DO
+*
+* Factorize panel
+*
+ CALL DGETRF( N-(J+1)*NB, NB,
+ $ WORK, N,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Copy panel back
+*
+ DO K = 1, NB
+ CALL DCOPY( N-(J+1)*NB,
+ $ WORK( 1+(K-1)*N ), 1,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA )
+ END DO
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL DLASET( 'Full', KB, NB, ZERO, ZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL DLACPY( 'Upper', KB, NB,
+ $ WORK, N,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL DTRSM( 'R', 'U', 'N', 'U', KB, NB, ONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J,J+1) into T(J+1, J), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB )
+ $ = TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ CALL DLASET( 'Lower', KB, NB, ZERO, ONE,
+ $ A( J*NB+1, (J+1)*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL DSWAP( K-1, A( (J+1)*NB+1, I1 ), 1,
+ $ A( (J+1)*NB+1, I2 ), 1 )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL DSWAP( I2-I1-1, A( I1, I1+1 ), LDA,
+ $ A( I1+1, I2 ), 1 )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL DSWAP( N-I2, A( I1, I2+1 ), LDA,
+ $ A( I2, I2+1 ), LDA )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL DSWAP( J*NB, A( 1, I1 ), 1,
+ $ A( 1, I2 ), 1 )
+ END IF
+ ENDIF
+ END DO
+ END IF
+ END DO
+ ELSE
+*
+* .....................................................
+* Factorize A as L*D*L**T using the lower triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*L(J,I)' + T(I+1,I)'*L(J,I+1)'
+ IF( I .EQ. J-1) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL DGEMM( 'NoTranspose', 'Transpose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (I-1)*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*L(J,I-1)' + T(I,I)*L(J,I)' + T(I,I+1)*L(J,I+1)'
+ IF( I .EQ. J-1) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL DGEMM( 'NoTranspose', 'Transpose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (I-2)*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL DLACPY( 'Lower', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = L(J,1:J)*H(1:J)
+ CALL DGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -ONE, A( J*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += L(J,J)*T(J,J-1)*L(J,J-1)'
+ CALL DGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ ONE, A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ ZERO, WORK( 1 ), N )
+ CALL DGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, NB,
+ $ -ONE, WORK( 1 ), N,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+ IF( J.GT.0 ) THEN
+ CALL DSYGST( 1, 'Lower', KB,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA, IINFO )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ $ = TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL DGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, KB,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL DGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, NB+KB,
+ $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL DGEMM( 'NoTranspose', 'NoTranspose',
+ $ N-(J+1)*NB, NB, J*NB,
+ $ -ONE, A( (J+1)*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, A( (J+1)*NB+1, J*NB+1 ), LDA )
+ END IF
+*
+* Factorize panel
+*
+ CALL DGETRF( N-(J+1)*NB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL DLASET( 'Full', KB, NB, ZERO, ZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL DLACPY( 'Upper', KB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL DTRSM( 'R', 'L', 'T', 'U', KB, NB, ONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J+1,J) into T(J, J+1), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB )
+ $ = TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ CALL DLASET( 'Upper', KB, NB, ZERO, ONE,
+ $ A( (J+1)*NB+1, J*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL DSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA,
+ $ A( I2, (J+1)*NB+1 ), LDA )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL DSWAP( I2-I1-1, A( I1+1, I1 ), 1,
+ $ A( I2, I1+1 ), LDA )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL DSWAP( N-I2, A( I2+1, I1 ), 1,
+ $ A( I2+1, I2 ), 1 )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL DSWAP( J*NB, A( I1, 1 ), LDA,
+ $ A( I2, 1 ), LDA )
+ END IF
+ ENDIF
+ END DO
+*
+* Apply pivots to previous columns of L
+*
+c CALL DLASWP( J*NB, A( 1, 1 ), LDA,
+c $ (J+1)*NB+1, (J+1)*NB+KB, IPIV, 1 )
+ END IF
+ END DO
+ END IF
+*
+* Factor the band matrix
+ CALL DGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO )
+*
+* End of DSYTRF_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
* =====================================================================
SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL DSYTRI, DSYTRI2X
+ EXTERNAL DSYTRI, DSYTRI2X, XERBLA
* ..
* .. Executable Statements ..
*
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (N+NNB+1,NNB+3)
+*> WORK is DOUBLE PRECISION array, dimension (N+NB+1,NB+3)
*> \endverbatim
*>
*> \param[in] NB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleSYcomputational
*
* =====================================================================
SUBROUTINE DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE DSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL DSYTRI_3X
+ EXTERNAL DSYTRI_3X, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleSYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE DSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleSYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> of the matrix B. NRHS >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,N)
*> Details of factors computed by DSYTRF_AA.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleSYcomputational
*
SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL DGTSV, DSWAP, DTRSM, XERBLA
+ EXTERNAL DLACPY, DGTSV, DSWAP, DTRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief \b DSYTRS_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSYTRS_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrs_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrs_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrs_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+* IPIV2, B, LDB, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* DOUBLE PRECISION A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DSYTRS_AA_2STAGE solves a system of linear equations A*X = B with a real
+*> symmetric matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by DSYTRF_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the details of the factorization are stored
+*> as an upper or lower triangular matrix.
+*> = 'U': Upper triangular, form is A = U*T*U**T;
+*> = 'L': Lower triangular, form is A = L*T*L**T.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (LDA,N)
+*> Details of factors computed by DSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is DOUBLE PRECISION array, dimension (LTB)
+*> Details of factors computed by DSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> DSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] IPIV2
+*> \verbatim
+*> IPIV2 is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> DSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup doubleSYcomputational
+*
+* =====================================================================
+ SUBROUTINE DSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ DOUBLE PRECISION A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+* =====================================================================
+*
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER LDTB, NB
+ LOGICAL UPPER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGBTRS, DLASWP, DTRSM, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LTB.LT.( 4*N ) ) THEN
+ INFO = -7
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DSYTRS_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. NRHS.EQ.0 )
+ $ RETURN
+*
+* Read NB and compute LDTB
+*
+ NB = INT( TB( 1 ) )
+ LDTB = LTB/N
+*
+ IF( UPPER ) THEN
+*
+* Solve A*X = B, where A = U*T*U**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL DLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ]
+*
+ CALL DTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (U**T \P**T * B) ]
+*
+ CALL DGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ]
+*
+ CALL DTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ]
+*
+ CALL DLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+*
+ ELSE
+*
+* Solve A*X = B, where A = L*T*L**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL DLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
+*
+ CALL DTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (L \P**T * B) ]
+*
+ CALL DGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
+*
+ CALL DTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
+*
+ CALL DLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of DSYTRS_AA_2STAGE
+*
+ END
*> \verbatim
*> PL is DOUBLE PRECISION
*> \endverbatim
-
+*>
*> \param[out] PR
*> \verbatim
*> PR is DOUBLE PRECISION
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array,
-*> dimension (MAX(1,LWORK))
+*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
$ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL,
$ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[in,out] A
*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
-*> On entry, the lower triangular N-by-N matrix A.
+*> A is DOUBLE PRECISION array, dimension (LDA,M)
+*> On entry, the lower triangular M-by-M matrix A.
*> On exit, the elements on and below the diagonal of the array
*> contain the lower triangular matrix L.
*> \endverbatim
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[in,out] B
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*> C = [ A ] [ B ]
*>
*>
-*> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*> where A is an lower triangular M-by-M matrix, and B is M-by-N pentagonal
*> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L
*> upper trapezoidal matrix B2:
*> [ B ] = [ B1 ] [ B2 ]
*> [ B1 ] <- M-by-(N-L) rectangular
-*> [ B2 ] <- M-by-L upper trapezoidal.
+*> [ B2 ] <- M-by-L lower trapezoidal.
*>
*> The lower trapezoidal matrix B2 consists of the first L columns of a
-*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
+*> M-by-M lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
*> B is rectangular M-by-N; if M=L=N, B is lower triangular.
*>
*> The matrix W stores the elementary reflectors H(i) in the i-th row
*> above the diagonal (of A) in the M-by-(M+N) input matrix C
*> [ C ] = [ A ] [ B ]
-*> [ A ] <- lower triangular N-by-N
+*> [ A ] <- lower triangular M-by-M
*> [ B ] <- M-by-N pentagonal
*>
*> so that W can be represented as
*> [ W ] = [ I ] [ V ]
-*> [ I ] <- identity, N-by-N
+*> [ I ] <- identity, M-by-M
*> [ V ] <- M-by-N, same form as B.
*>
*> Thus, all of information needed for W is contained on exit in B, which
SUBROUTINE DTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LDT, N, M, L, MB
*>
*> \param[in,out] A
*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,N)
+*> A is DOUBLE PRECISION array, dimension (LDA,M)
*> On entry, the lower triangular M-by-M matrix A.
*> On exit, the elements on and below the diagonal of the array
*> contain the lower triangular matrix L.
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[in,out] B
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*> C = [ A ][ B ]
*>
*>
-*> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*> where A is an lower triangular M-by-M matrix, and B is M-by-N pentagonal
*> matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L
*> upper trapezoidal matrix B2:
*>
*> above the diagonal (of A) in the M-by-(M+N) input matrix C
*>
*> C = [ A ][ B ]
-*> [ A ] <- lower triangular N-by-N
+*> [ A ] <- lower triangular M-by-M
*> [ B ] <- M-by-N pentagonal
*>
*> so that W can be represented as
*>
*> W = [ I ][ V ]
-*> [ I ] <- identity, N-by-N
+*> [ I ] <- identity, M-by-M
*> [ V ] <- M-by-N, same form as B.
*>
*> Thus, all of information needed for W is contained on exit in B, which
* =====================================================================
SUBROUTINE DTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LDT, N, M, L
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHERcomputational
*
SUBROUTINE DTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
$ A, LDA, B, LDB, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, DLARFB
+ EXTERNAL XERBLA, DLARFB, DTPRFB
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHERcomputational
*
SUBROUTINE DTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
$ A, LDA, B, LDB, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL DTPRFB, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHERcomputational
*
SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
$ LDVR, MM, M, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH
* ..
* .. External Subroutines ..
- EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA
+ EXTERNAL DLABAD, DAXPY, DCOPY, DGEMV, DLALN2, DSCAL,
+ $ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
* @precisions fortran d -> s
*
$ VR, LDVR, MM, M, WORK, LWORK, INFO )
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
* ..
* .. External Subroutines ..
EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA,
- $ DGEMM, DLASET, DLABAD
+ $ DGEMM, DLASET, DLABAD, DLACPY
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHERcomputational
*
$ LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, JOB
EXTERNAL LSAME, DDOT, DLAMCH, DLAPY2, DNRM2
* ..
* .. External Subroutines ..
- EXTERNAL DLACN2, DLACPY, DLAQTR, DTREXC, XERBLA
+ EXTERNAL DLABAD, DLACN2, DLACPY, DLAQTR, DTREXC, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SQRT
*>
*> \param[out] AP
*> \verbatim
-*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2
+*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
*> On exit, the upper or lower triangular matrix A, packed
*> columnwise in a linear array. The j-th column of A is stored
*> in the array AP as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
* =====================================================================
SUBROUTINE DTRTTP( UPLO, N, A, LDA, AP, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*>
*> \param[in] A
*> \verbatim
-*> A is array, dimension (LDA,N)
+*> A is COMPLEX array, dimension (LDA,N)
*> The m by n matrix A.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complexOTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILACLR( M, N, A, LDA )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*( * ) NAME, OPTS
*
* .. Local Scalars ..
INTEGER I, IC, IZ, NB, NBMIN, NX
- LOGICAL CNAME, SNAME
- CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*6
+ LOGICAL CNAME, SNAME, TWOSTAGE
+ CHARACTER C1*1, C2*2, C4*2, C3*3, SUBNAM*16
* ..
* .. Intrinsic Functions ..
INTRINSIC CHAR, ICHAR, INT, MIN, REAL
* .. Executable Statements ..
*
GO TO ( 10, 10, 10, 80, 90, 100, 110, 120,
- $ 130, 140, 150, 160, 160, 160, 160, 160,
- $ 170, 170, 170, 170, 170 )ISPEC
+ $ 130, 140, 150, 160, 160, 160, 160, 160)ISPEC
*
* Invalid value for ISPEC
*
C2 = SUBNAM( 2: 3 )
C3 = SUBNAM( 4: 6 )
C4 = C3( 2: 3 )
+ TWOSTAGE = LEN( SUBNAM ).GE.11
+ $ .AND. SUBNAM( 11: 11 ).EQ.'2'
*
GO TO ( 50, 60, 70 )ISPEC
*
ELSE IF( C2.EQ.'SY' ) THEN
IF( C3.EQ.'TRF' ) THEN
IF( SNAME ) THEN
- NB = 64
+ IF( TWOSTAGE ) THEN
+ NB = 192
+ ELSE
+ NB = 64
+ END IF
ELSE
- NB = 64
+ IF( TWOSTAGE ) THEN
+ NB = 192
+ ELSE
+ NB = 64
+ END IF
END IF
ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
NB = 32
END IF
ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
IF( C3.EQ.'TRF' ) THEN
- NB = 64
+ IF( TWOSTAGE ) THEN
+ NB = 192
+ ELSE
+ NB = 64
+ END IF
ELSE IF( C3.EQ.'TRD' ) THEN
NB = 32
ELSE IF( C3.EQ.'GST' ) THEN
ILAENV = IPARMQ( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
RETURN
*
- 170 CONTINUE
-*
-* 17 <= ISPEC <= 21: 2stage eigenvalues and SVD or related subroutines.
-*
- ILAENV = IPARAM2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
- RETURN
-*
* End of ILAENV
*
END
--- /dev/null
+*> \brief \b ILAENV2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILAENV2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaenv2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaenv2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaenv2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* INTEGER FUNCTION ILAENV2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
+*
+* .. Scalar Arguments ..
+* CHARACTER*( * ) NAME, OPTS
+* INTEGER ISPEC, N1, N2, N3, N4
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ILAENV2STAGE is called from the LAPACK routines to choose problem-dependent
+*> parameters for the local environment. See ISPEC for a description of
+*> the parameters.
+*> It sets problem and machine dependent parameters useful for *_2STAGE and
+*> related subroutines.
+*>
+*> ILAENV2STAGE returns an INTEGER
+*> if ILAENV2STAGE >= 0: ILAENV2STAGE returns the value of the parameter
+* specified by ISPEC
+*> if ILAENV2STAGE < 0: if ILAENV2STAGE = -k, the k-th argument had an
+* illegal value.
+*>
+*> This version provides a set of parameters which should give good,
+*> but not optimal, performance on many of the currently available
+*> computers for the 2-stage solvers. Users are encouraged to modify this
+*> subroutine to set the tuning parameters for their particular machine using
+*> the option and problem size information in the arguments.
+*>
+*> This routine will not function correctly if it is converted to all
+*> lower case. Converting it to all upper case is allowed.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] ISPEC
+*> \verbatim
+*> ISPEC is INTEGER
+*> Specifies the parameter to be returned as the value of
+*> ILAENV2STAGE.
+*> = 1: the optimal blocksize nb for the reduction to BAND
+*>
+*> = 2: the optimal blocksize ib for the eigenvectors
+*> singular vectors update routine
+*>
+*> = 3: The length of the array that store the Housholder
+*> representation for the second stage
+*> Band to Tridiagonal or Bidiagonal
+*>
+*> = 4: The workspace needed for the routine in input.
+*>
+*> = 5: For future release.
+*> \endverbatim
+*>
+*> \param[in] NAME
+*> \verbatim
+*> NAME is CHARACTER*(*)
+*> The name of the calling subroutine, in either upper case or
+*> lower case.
+*> \endverbatim
+*>
+*> \param[in] OPTS
+*> \verbatim
+*> OPTS is CHARACTER*(*)
+*> The character options to the subroutine NAME, concatenated
+*> into a single character string. For example, UPLO = 'U',
+*> TRANS = 'T', and DIAG = 'N' for a triangular routine would
+*> be specified as OPTS = 'UTN'.
+*> \endverbatim
+*>
+*> \param[in] N1
+*> \verbatim
+*> N1 is INTEGER
+*> \endverbatim
+*>
+*> \param[in] N2
+*> \verbatim
+*> N2 is INTEGER
+*> \endverbatim
+*>
+*> \param[in] N3
+*> \verbatim
+*> N3 is INTEGER
+*> \endverbatim
+*>
+*> \param[in] N4
+*> \verbatim
+*> N4 is INTEGER
+*> Problem dimensions for the subroutine NAME; these may not all
+*> be required.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*> \author Nick R. Papior
+*
+*> \date July 2017
+*
+*> \ingroup OTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> The following conventions have been used when calling ILAENV2STAGE
+*> from the LAPACK routines:
+*> 1) OPTS is a concatenation of all of the character options to
+*> subroutine NAME, in the same order that they appear in the
+*> argument list for NAME, even if they are not used in determining
+*> the value of the parameter specified by ISPEC.
+*> 2) The problem dimensions N1, N2, N3, N4 are specified in the order
+*> that they appear in the argument list for NAME. N1 is used
+*> first, N2 second, and so on, and unused problem dimensions are
+*> passed a value of -1.
+*> 3) The parameter value returned by ILAENV2STAGE is checked for validity in
+*> the calling subroutine.
+*>
+*> \endverbatim
+*>
+* =====================================================================
+ INTEGER FUNCTION ILAENV2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
+*
+* -- LAPACK auxiliary routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* July 2017
+*
+* .. Scalar Arguments ..
+ CHARACTER*( * ) NAME, OPTS
+ INTEGER ISPEC, N1, N2, N3, N4
+* ..
+*
+* =====================================================================
+* ..
+* .. Local Scalars ..
+ INTEGER IISPEC
+* ..
+* .. External Functions ..
+ INTEGER IPARAM2STAGE
+ EXTERNAL IPARAM2STAGE
+* ..
+* .. Executable Statements ..
+*
+ GO TO ( 10, 10, 10, 10, 10 )ISPEC
+*
+* Invalid value for ISPEC
+*
+ ILAENV2STAGE = -1
+ RETURN
+*
+ 10 CONTINUE
+*
+* 2stage eigenvalues and SVD or related subroutines.
+*
+ IISPEC = 16 + ISPEC
+ ILAENV2STAGE = IPARAM2STAGE( IISPEC, NAME, OPTS,
+ $ N1, N2, N3, N4 )
+ RETURN
+*
+* End of ILAENV2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILASLC( M, N, A, LDA )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
*
* .. Parameters ..
REAL ZERO
- PARAMETER ( ZERO = 0.0D+0 )
+ PARAMETER ( ZERO = 0.0E+0 )
* ..
* .. Local Scalars ..
INTEGER I
+++ /dev/null
-*> \brief \b ILAVER returns the LAPACK version.
-**
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
-*
-* INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> This subroutine returns the LAPACK version.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[out] VERS_MAJOR
-*> \verbatim
-*> return the lapack major version
-*> \endverbatim
-*>
-*> \param[out] VERS_MINOR
-*> \verbatim
-*> return the lapack minor version from the major version
-*> \endverbatim
-*>
-*> \param[out] VERS_PATCH
-*> \verbatim
-*> return the lapack patch version from the minor version
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date December 2016
-*
-*> \ingroup OTHERauxiliary
-*
-* =====================================================================
- SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
-*
-* -- LAPACK computational routine (version 3.7.0) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* June 2016
-*
-* =====================================================================
-*
- INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
-* =====================================================================
- VERS_MAJOR = 3
- VERS_MINOR = 7
- VERS_PATCH = 0
-* =====================================================================
-*
- RETURN
- END
*> useful for xHETRD_2STAGE, xHETRD_H@2HB, xHETRD_HB2ST,
*> xGEBRD_2STAGE, xGEBRD_GE2GB, xGEBRD_GB2BD
*> and related subroutines for eigenvalue problems.
-*> It is called whenever ILAENV is called with 17 <= ISPEC <= 21
+*> It is called whenever ILAENV is called with 17 <= ISPEC <= 21.
+*> It is called whenever ILAENV2STAGE is called with 1 <= ISPEC <= 5
+*> with a direct conversion ISPEC + 16.
*> \endverbatim
*
* Arguments:
#endif
IMPLICIT NONE
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
INTEGER I, IC, IZ, KD, IB, LHOUS, LWORK, NTHREADS,
$ FACTOPTNB, QROPTNB, LQOPTNB
LOGICAL RPREC, CPREC
- CHARACTER PREC*1, ALGO*3, STAG*5, SUBNAM*12, VECT*3
+ CHARACTER PREC*1, ALGO*3, STAG*5, SUBNAM*12, VECT*1
* ..
* .. Intrinsic Functions ..
INTRINSIC CHAR, ICHAR, MAX
*
*> \param[in] ISPEC
*> \verbatim
-*> ISPEC is integer scalar
+*> ISPEC is INTEGER
*> ISPEC specifies which tunable parameter IPARMQ should
*> return.
*>
*>
*> \param[in] N
*> \verbatim
-*> N is integer scalar
+*> N is INTEGER
*> N is the order of the Hessenberg matrix H.
*> \endverbatim
*>
*>
*> \param[in] LWORK
*> \verbatim
-*> LWORK is integer scalar
+*> LWORK is INTEGER
*> The amount of workspace available.
*> \endverbatim
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IHI, ILO, ISPEC, LWORK, N
*>
*> \param[in,out] V2T
*> \verbatim
-*> V2T is REAL array, dimenison (LDV2T,M-Q)
+*> V2T is REAL array, dimension (LDV2T,M-Q)
*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is
*> premultiplied by the transpose of the right
*> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and
$ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E,
$ B22D, B22E, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ,
$ WORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
WSTART = 1
QSTART = 3
IF( ICOMPQ.EQ.1 ) THEN
- CALL SCOPY( N, D, 1, Q( 1 ), 1 )
+ CALL SCOPY( N, D, 1, Q( 1 ), 1 )
CALL SCOPY( N-1, E, 1, Q( N+1 ), 1 )
END IF
IF( IUPLO.EQ.2 ) THEN
QSTART = 5
- WSTART = 2*N - 1
+ IF( ICOMPQ .EQ. 2 ) WSTART = 2*N - 1
DO 10 I = 1, N - 1
CALL SLARTG( D( I ), E( I ), CS, SN, R )
D( I ) = R
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
$ LDU, C, LDC, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* ..
* .. Local Scalars ..
LOGICAL LOWER, ROTATE
- INTEGER I, IDIR, ISUB, ITER, ITERDIVN J, LL, LLL, M,
+ INTEGER I, IDIR, ISUB, ITER, ITERDIVN, J, LL, LLL, M,
$ MAXITDIVN, NM1, NM12, NM13, OLDLL, OLDM
REAL ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
$ OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
*
IF( M.LE.1 )
$ GO TO 160
-*
+*
IF( ITER.GE.N ) THEN
- ITER = ITER - N
+ ITER = ITER - N
ITERDIVN = ITERDIVN + 1
IF( ITERDIVN.GE.MAXITDIVN )
- $ GO TO 200
+ $ GO TO 200
END IF
*
* Find diagonal block of matrix to work on
SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
$ NS, S, Z, LDZ, WORK, IWORK, INFO)
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, RANGE, UPLO
EXTERNAL ISAMAX, LSAME, SAXPY, SDOT, SLAMCH, SNRM2
* ..
* .. External Subroutines ..
- EXTERNAL SCOPY, SLASET, SSCAL, SSWAP
+ EXTERNAL SCOPY, SLASET, SSCAL, SSWAP, SSTEVX, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, REAL, SIGN, SQRT
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is REAL array dimension (min(M,N))
+*> TAUQ is REAL array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the orthogonal matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGEcomputational
*
* =====================================================================
SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is REAL array dimension (min(M,N))
+*> TAUQ is REAL array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the orthogonal matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realGEcomputational
*
SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
- $ NBMIN, NX
- REAL WS
+ $ NBMIN, NX, WS
* ..
* .. External Subroutines ..
EXTERNAL SGEBD2, SGEMM, SLABRD, XERBLA
*>
*> \param[in] SELECT
*> \verbatim
-*> SELECT is LOGICAL FUNCTION of two REAL arguments
+*> SELECT is a LOGICAL FUNCTION of two REAL arguments
*> SELECT must be declared EXTERNAL in the calling subroutine.
*> If SORT = 'S', SELECT is used to select eigenvalues to sort
*> to the top left of the Schur form.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGEeigen
*
SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI,
$ VS, LDVS, WORK, LWORK, BWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBVS, SORT
* .. Scalar Arguments ..
* CHARACTER BALANC, JOBVL, JOBVR, SENSE
* INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
-* REAL ABNRM
+* REAL ABNRM
* ..
* .. Array Arguments ..
* INTEGER IWORK( * )
-* REAL A( LDA, * ), RCONDE( * ), RCONDV( * ),
+* REAL A( LDA, * ), RCONDE( * ), RCONDV( * ),
* $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ),
* $ WI( * ), WORK( * ), WR( * )
* ..
$ RCONDE, RCONDV, WORK, LWORK, IWORK, INFO )
implicit none
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
- REAL ABNRM
+ REAL ABNRM
* ..
* .. Array Arguments ..
INTEGER IWORK( * )
- REAL A( LDA, * ), RCONDE( * ), RCONDV( * ),
+ REAL A( LDA, * ), RCONDE( * ), RCONDV( * ),
$ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ),
$ WI( * ), WORK( * ), WR( * )
* ..
CHARACTER JOB, SIDE
INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K,
$ LWORK_TREVC, MAXWRK, MINWRK, NOUT
- REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
+ REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
$ SN
* ..
* .. Local Arrays ..
LOGICAL SELECT( 1 )
- REAL DUM( 1 )
+ REAL DUM( 1 )
* ..
* .. External Subroutines ..
EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY,
* .. External Functions ..
LOGICAL LSAME
INTEGER ISAMAX, ILAENV
- REAL SLAMCH, SLANGE, SLAPY2, SNRM2
+ REAL SLAMCH, SLANGE, SLAPY2, SNRM2
EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SLANGE, SLAPY2,
$ SNRM2
* ..
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension at least LWORK.
+*> WORK is REAL array, dimension (LWORK)
*> On exit,
*> WORK(1) = SCALE = WORK(2) / WORK(1) is the scaling factor such
*> that SCALE*SVA(1:N) are the computed singular values
*>
*> \param[out] IWORK
*> \verbatim
-*> IWORK is INTEGER array, dimension M+3*N.
+*> IWORK is INTEGER array, dimension (M+3*N).
*> On exit,
*> IWORK(1) = the numerical rank determined after the initial
*> QR factorization with pivoting. See the descriptions
$ M, N, A, LDA, SVA, U, LDU, V, LDV,
$ WORK, LWORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
*>
*> \verbatim
*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
+*> The matrix V stores the elementary reflectors H(i) in the i-th row
+*> above the diagonal. For example, if M=5 and N=3, the matrix V is
*>
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
*>
*> where the vi's represent the vectors which define H(i), which are returned
*> in the matrix A. The 1's along the diagonal of V are not stored in A.
-*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each
-*> block is of order NB except for the last block, which is of order
-*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
-*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
+*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/MB), where each
+*> block is of order MB except for the last block, which is of order
+*> IB = K - (B-1)*MB. For each of the B blocks, a upper triangular block
+*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB
+*> for the last block) T's are stored in the MB-by-K matrix T as
*>
*> T = (T1 T2 ... TB).
*> \endverbatim
* =====================================================================
SUBROUTINE SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDT, M, N, MB
INTEGER I, IB, IINFO, K
* ..
* .. External Subroutines ..
- EXTERNAL SGEQRT2, SGEQRT3, SLARFB, XERBLA
+ EXTERNAL SGEQRT2, SGEQRT3, SGELQT3, SLARFB, XERBLA
* ..
* .. Executable Statements ..
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
*>
*> \verbatim
*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
+*> The matrix V stores the elementary reflectors H(i) in the i-th row
+*> above the diagonal. For example, if M=5 and N=3, the matrix V is
*>
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
* =====================================================================
RECURSIVE SUBROUTINE SGELQT3( M, N, A, LDA, T, LDT, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, LDT
*
* .. Parameters ..
REAL ONE
- PARAMETER ( ONE = 1.0D+00 )
+ PARAMETER ( ONE = 1.0E+00 )
* ..
* .. Local Scalars ..
- INTEGER I, I1, J, J1, M1, M2, N1, N2, IINFO
+ INTEGER I, I1, J, J1, M1, M2, IINFO
* ..
* .. External Subroutines ..
- EXTERNAL DLARFG, DTRMM, DGEMM, XERBLA
+ EXTERNAL SLARFG, STRMM, SGEMM, XERBLA
* ..
* .. Executable Statements ..
*
*> of the matrices B and X. NRHS >= 0.
*> \endverbatim
*>
-*> \param[in] A
+*> \param[in,out] A
*> \verbatim
*> A is REAL array, dimension (LDA,N)
*> On entry, the M-by-N matrix A.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGEsolve
*
SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND,
$ RANK, WORK, LWORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
*>
*> \verbatim
*>
-*> DGEMQRT overwrites the general real M-by-N matrix C with
+*> DGEMLQT overwrites the general real M-by-N matrix C with
*>
*> SIDE = 'L' SIDE = 'R'
*> TRANS = 'N': Q C C Q
*>
*> \param[in] V
*> \verbatim
-*> V is REAL array, dimension (LDV,K)
+*> V is REAL array, dimension
+*> (LDV,M) if SIDE = 'L',
+*> (LDV,N) if SIDE = 'R'
*> The i-th row must contain the vector which defines the
*> elementary reflector H(i), for i = 1,2,...,k, as returned by
*> DGELQT in the first K rows of its array argument A.
*> \param[in] LDV
*> \verbatim
*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
+*> The leading dimension of the array V. LDV >= max(1,K).
*> \endverbatim
*>
*> \param[in] T
*> \verbatim
*> T is REAL array, dimension (LDT,K)
*> The upper triangular factors of the block reflectors
-*> as returned by DGELQT, stored as a MB-by-M matrix.
+*> as returned by DGELQT, stored as a MB-by-K matrix.
*> \endverbatim
*>
*> \param[in] LDT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
SUBROUTINE SGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT,
$ C, LDC, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN
- INTEGER I, IB, LDWORK, KF, Q
+ INTEGER I, IB, LDWORK, KF
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, DLARFB
+ EXTERNAL XERBLA, SLARFB
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGEcomputational
*
*> block is of order NB except for the last block, which is of order
*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
+*> for the last block) T's are stored in the NB-by-K matrix T as
*>
*> T = (T1 T2 ... TB).
*> \endverbatim
* =====================================================================
SUBROUTINE SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDT, M, N, NB
$ IL, IU, NS, S, U, LDU, VT, LDVT, WORK,
$ LWORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. External Subroutines ..
EXTERNAL SBDSVDX, SGEBRD, SGELQF, SGEQRF, SLACPY,
$ SLASCL, SLASET, SORMBR, SORMLQ, SORMQR,
- $ XERBLA
+ $ SCOPY, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
*
*> \param[in] JOBA
*> \verbatim
-*> JOBA is CHARACTER* 1
+*> JOBA is CHARACTER*1
*> Specifies the structure of A.
*> = 'L': The input matrix A is lower triangular;
*> = 'U': The input matrix A is upper triangular;
*>
*> \param[in,out] WORK
*> \verbatim
-*> WORK is REAL array, dimension MAX(6,M+N).
+*> WORK is REAL array, dimension (LWORK)
*> On entry,
*> If JOBU .EQ. 'C' :
*> WORK(1) = CTOL, where CTOL defines the threshold for convergence.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGEcomputational
*
SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
$ LDV, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDV, LWORK, M, MV, N
*>
*> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2
*> A = [ -----|----- ] with n1 = min(m,n)/2
-* [ A21 | A22 ] n2 = n-n1
+*> [ A21 | A22 ] n2 = n-n1
*>
*> [ A11 ]
*> The subroutine calls itself to factor [ --- ],
* =====================================================================
RECURSIVE SUBROUTINE SGETRF2( M, N, A, LDA, IPIV, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEsolve
*
SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS
INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW,
$ SCLLEN, MNK, TSZO, TSZM, LWO, LWM, LW1, LW2,
$ WSIZEO, WSIZEM, INFO2
- REAL ANRM, BIGNUM, BNRM, SMLNUM, TQ( 5 ), WORKQ
+ REAL ANRM, BIGNUM, BNRM, SMLNUM, TQ( 5 ), WORKQ( 1 )
* ..
* .. External Functions ..
LOGICAL LSAME
IF( M.GE.N ) THEN
CALL SGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
- LWO = INT( WORKQ )
+ LWO = INT( WORKQ( 1 ) )
CALL SGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWO = MAX( LWO, INT( WORKQ ) )
+ LWO = MAX( LWO, INT( WORKQ( 1 ) ) )
CALL SGEQR( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
TSZM = INT( TQ( 1 ) )
- LWM = INT( WORKQ )
+ LWM = INT( WORKQ( 1 ) )
CALL SGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
$ TSZM, B, LDB, WORKQ, -1, INFO2 )
- LWM = MAX( LWM, INT( WORKQ ) )
+ LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
WSIZEO = TSZO + LWO
WSIZEM = TSZM + LWM
ELSE
CALL SGELQ( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
- LWO = INT( WORKQ )
+ LWO = INT( WORKQ( 1 ) )
CALL SGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWO = MAX( LWO, INT( WORKQ ) )
+ LWO = MAX( LWO, INT( WORKQ( 1 ) ) )
CALL SGELQ( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
TSZM = INT( TQ( 1 ) )
- LWM = INT( WORKQ )
+ LWM = INT( WORKQ( 1 ) )
CALL SGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWM = MAX( LWM, INT( WORKQ ) )
+ LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
WSIZEO = TSZO + LWO
WSIZEM = TSZM + LWM
END IF
*>
*> \param[in] SELCTG
*> \verbatim
-*> SELCTG is procedure) LOGICAL FUNCTION of three REAL arguments
+*> SELCTG is a LOGICAL FUNCTION of three REAL arguments
*> SELCTG must be declared EXTERNAL in the calling subroutine.
*> If SORT = 'N', SELCTG is not referenced.
*> If SORT = 'S', SELCTG is used to select eigenvalues to sort
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGEeigen
*
$ VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK,
$ LIWORK, BWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SENSE, SORT
SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
$ LDQ, Z, LDZ, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.6.1) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2015
EXTERNAL ILAENV, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL SGGHRD, SLARTG, SLASET, SORM22, SROT, XERBLA
+ EXTERNAL SGGHRD, SLARTG, SLASET, SORM22, SROT, SGEMM,
+ $ SGEMV, STRMV, SLACPY, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC REAL, MAX
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension LWORK.
+*> WORK is REAL array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realOTHERcomputational
*
SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS,
$ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDV, LWORK, M, MV, N, NSWEEP
EXTERNAL ISAMAX, LSAME, SDOT, SNRM2
* ..
* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, SSWAP
+ EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, SSWAP,
+ $ XERBLA
* ..
* .. Executable Statements ..
*
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension LWORK.
+*> WORK is REAL array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realOTHERcomputational
*
SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
$ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
REAL EPS, SFMIN, TOL
EXTERNAL ISAMAX, LSAME, SDOT, SNRM2
* ..
* .. External Subroutines ..
- EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, SSWAP
+ EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, SSWAP,
+ $ XERBLA
* ..
* .. Executable Statements ..
*
* LOGICAL FUNCTION SISNAN( SIN )
*
* .. Scalar Arguments ..
-* REAL SIN
+* REAL, INTENT(IN) :: SIN
* ..
*
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
LOGICAL FUNCTION SISNAN( SIN )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
- REAL SIN
+ REAL, INTENT(IN) :: SIN
* ..
*
* =====================================================================
*>
*> \param[in] AB
*> \verbatim
-*> AB is REAL array of DIMENSION ( LDAB, n )
+*> AB is REAL array, dimension ( LDAB, n )
*> Before entry, the leading m by n part of the array AB must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGBcomputational
*
SUBROUTINE SLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
$ INCX, BETA, Y, INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
REAL ALPHA, BETA
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is REAL array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is REAL array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGBcomputational
*
$ Y_TAIL, RCOND, ITHRESH, RTHRESH,
$ DZ_UB, IGNORE_CWISE, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDAB, LDAFB, LDB, LDY, N, KL, KU, NRHS,
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n )
+*> A is REAL array, dimension ( LDA, n )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is REAL
-*> Array of DIMENSION at least
+*> Y is REAL array,
+*> dimension at least
*> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGEcomputational
*
SUBROUTINE SLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
$ Y, INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
REAL ALPHA, BETA
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION ( LDA, n ).
+*> A is REAL array, dimension ( LDA, n ).
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realSYcomputational
*
SUBROUTINE SLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
$ INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
REAL ALPHA, BETA
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is REAL array dimension (NB)
+*> TAUQ is REAL array, dimension (NB)
*> The scalar factors of the elementary reflectors which
*> represent the orthogonal matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERauxiliary
*
SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
$ LDY )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, LDX, LDY, M, N, NB
*>
*> \param[in] Q2
*> \verbatim
-*> Q2 is REAL array, dimension (LDQ2, N)
+*> Q2 is REAL array, dimension (LDQ2*N)
*> The first K columns of this matrix contain the non-deflated
*> eigenvectors for the split problem.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
SUBROUTINE SLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX,
$ CTOT, W, S, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDQ, N, N1
* LOGICAL FUNCTION SLAISNAN( SIN1, SIN2 )
*
* .. Scalar Arguments ..
-* REAL SIN1, SIN2
+* REAL, INTENT(IN) :: SIN1, SIN2
* ..
*
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
LOGICAL FUNCTION SLAISNAN( SIN1, SIN2 )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
- REAL SIN1, SIN2
+ REAL, INTENT(IN) :: SIN1, SIN2
* ..
*
* =====================================================================
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array.
-*> The dimension must be at least N.
+*> WORK is REAL array, dimension (N)
*> \endverbatim
*>
*> \param[out] IWORK
*> \verbatim
-*> IWORK is INTEGER array.
-*> The dimension must be at least 3 * N
+*> IWORK is INTEGER array, dimension (3*N)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERcomputational
*
$ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK,
$ IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
*>
*> \verbatim
*>
-*> DLAMQRTS overwrites the general real M-by-N matrix C with
+*> SLAMSWLQ overwrites the general real M-by-N matrix C with
*>
*>
*> SIDE = 'L' SIDE = 'R'
*> TRANS = 'T': Q**T * C C * Q**T
*> where Q is a real orthogonal matrix defined as the product of blocked
*> elementary reflectors computed by short wide LQ
-*> factorization (DLASWLQ)
+*> factorization (SLASWLQ)
*> \endverbatim
*
* Arguments:
*> \param[in] M
*> \verbatim
*> M is INTEGER
-*> The number of rows of the matrix A. M >=0.
+*> The number of rows of the matrix C. M >=0.
*> \endverbatim
*>
*> \param[in] N
*>
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
-*> A is REAL array, dimension (LDA,K)
+*> A is REAL array, dimension
+*> (LDA,M) if SIDE = 'L',
+*> (LDA,N) if SIDE = 'R'
*> The i-th row must contain the vector which defines the blocked
*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DLASWLQ in the first k rows of its array argument A.
+*> SLASWLQ in the first k rows of its array argument A.
*> \endverbatim
*>
*> \param[in] LDA
SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
END IF
*
IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN
- CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA,
+ CALL SGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA,
$ T, LDT, C, LDC, WORK, INFO)
RETURN
END IF
*> N >= NB >= 1.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is REAL array, dimension (LDA,K)
*> The i-th column must contain the vector which defines the
SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
REAL FUNCTION SLAPY2( X, Y )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
REAL X, Y
* ..
* .. Local Scalars ..
REAL W, XABS, YABS, Z
+ LOGICAL X_IS_NAN, Y_IS_NAN
+* ..
+* .. External Functions ..
+ LOGICAL SISNAN
+ EXTERNAL SISNAN
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT
* ..
* .. Executable Statements ..
*
- XABS = ABS( X )
- YABS = ABS( Y )
- W = MAX( XABS, YABS )
- Z = MIN( XABS, YABS )
- IF( Z.EQ.ZERO ) THEN
- SLAPY2 = W
- ELSE
- SLAPY2 = W*SQRT( ONE+( Z / W )**2 )
+* ..
+* .. Executable Statements ..
+*
+ X_IS_NAN = SISNAN( X )
+ Y_IS_NAN = SISNAN( Y )
+ IF ( X_IS_NAN ) SLAPY2 = X
+ IF ( Y_IS_NAN ) SLAPY2 = Y
+*
+ IF ( .NOT.( X_IS_NAN.OR.Y_IS_NAN ) ) THEN
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ W = MAX( XABS, YABS )
+ Z = MIN( XABS, YABS )
+ IF( Z.EQ.ZERO ) THEN
+ SLAPY2 = W
+ ELSE
+ SLAPY2 = W*SQRT( ONE+( Z / W )**2 )
+ END IF
END IF
RETURN
*
*
*> \param[in] N
*> \verbatim
-*> N is integer
+*> N is INTEGER
*> Order of the matrix H. N must be either 2 or 3.
*> \endverbatim
*>
*> \param[in] H
*> \verbatim
-*> H is REAL array of dimension (LDH,N)
+*> H is REAL array, dimension (LDH,N)
*> The 2-by-2 or 3-by-3 matrix H in (*).
*> \endverbatim
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> The leading dimension of H as declared in
*> the calling procedure. LDH.GE.N
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
-*> V is REAL array of dimension N
+*> V is REAL array, dimension (N)
*> A scalar multiple of the first column of the
*> matrix K in (*).
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERauxiliary
*
* =====================================================================
SUBROUTINE SLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
REAL SI1, SI2, SR1, SR2
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> Leading dimension of H just as declared in the calling
*> subroutine. N .LE. LDH
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer
+*> LDZ is INTEGER
*> The leading dimension of Z just as declared in the
*> calling subroutine. 1 .LE. LDZ.
*> \endverbatim
*>
*> \param[out] NS
*> \verbatim
-*> NS is integer
+*> NS is INTEGER
*> The number of unconverged (ie approximate) eigenvalues
*> returned in SR and SI that may be used as shifts by the
*> calling subroutine.
*>
*> \param[out] ND
*> \verbatim
-*> ND is integer
+*> ND is INTEGER
*> The number of converged eigenvalues uncovered by this
*> subroutine.
*> \endverbatim
*>
*> \param[out] SR
*> \verbatim
-*> SR is REAL array, dimension KBOT
+*> SR is REAL array, dimension (KBOT)
*> \endverbatim
*>
*> \param[out] SI
*> \verbatim
-*> SI is REAL array, dimension KBOT
+*> SI is REAL array, dimension (KBOT)
*> On output, the real and imaginary parts of approximate
*> eigenvalues that may be used for shifts are stored in
*> SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> The leading dimension of V just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> The number of columns of T. NH.GE.NW.
*> \endverbatim
*>
*>
*> \param[in] LDT
*> \verbatim
-*> LDT is integer
+*> LDT is INTEGER
*> The leading dimension of T just as declared in the
*> calling subroutine. NW .LE. LDT
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer
+*> NV is INTEGER
*> The number of rows of work array WV available for
*> workspace. NV.GE.NW.
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer
+*> LDWV is INTEGER
*> The leading dimension of W just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension LWORK.
+*> WORK is REAL array, dimension (LWORK)
*> On exit, WORK(1) is set to an estimate of the optimal value
*> of LWORK for the given values of N, NW, KTOP and KBOT.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
-*> LWORK is integer
+*> LWORK is INTEGER
*> The dimension of the work array WORK. LWORK = 2*NW
*> suffices, but greater efficiency may result from larger
*> values of LWORK.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERauxiliary
*
$ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
$ LDT, NV, WV, LDWV, WORK, LWORK )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> Leading dimension of H just as declared in the calling
*> subroutine. N .LE. LDH
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer
+*> LDZ is INTEGER
*> The leading dimension of Z just as declared in the
*> calling subroutine. 1 .LE. LDZ.
*> \endverbatim
*>
*> \param[out] NS
*> \verbatim
-*> NS is integer
+*> NS is INTEGER
*> The number of unconverged (ie approximate) eigenvalues
*> returned in SR and SI that may be used as shifts by the
*> calling subroutine.
*>
*> \param[out] ND
*> \verbatim
-*> ND is integer
+*> ND is INTEGER
*> The number of converged eigenvalues uncovered by this
*> subroutine.
*> \endverbatim
*>
*> \param[out] SR
*> \verbatim
-*> SR is REAL array, dimension KBOT
+*> SR is REAL array, dimension (KBOT)
*> \endverbatim
*>
*> \param[out] SI
*> \verbatim
-*> SI is REAL array, dimension KBOT
+*> SI is REAL array, dimension (KBOT)
*> On output, the real and imaginary parts of approximate
*> eigenvalues that may be used for shifts are stored in
*> SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> The leading dimension of V just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> The number of columns of T. NH.GE.NW.
*> \endverbatim
*>
*>
*> \param[in] LDT
*> \verbatim
-*> LDT is integer
+*> LDT is INTEGER
*> The leading dimension of T just as declared in the
*> calling subroutine. NW .LE. LDT
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer
+*> NV is INTEGER
*> The number of rows of work array WV available for
*> workspace. NV.GE.NW.
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer
+*> LDWV is INTEGER
*> The leading dimension of W just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension LWORK.
+*> WORK is REAL array, dimension (LWORK)
*> On exit, WORK(1) is set to an estimate of the optimal value
*> of LWORK for the given values of N, NW, KTOP and KBOT.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
-*> LWORK is integer
+*> LWORK is INTEGER
*> The dimension of the work array WORK. LWORK = 2*NW
*> suffices, but greater efficiency may result from larger
*> values of LWORK.
$ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
$ LDT, NV, WV, LDWV, WORK, LWORK )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
*> \param[in] WANTT
*> \verbatim
-*> WANTT is logical scalar
+*> WANTT is LOGICAL
*> WANTT = .true. if the quasi-triangular Schur factor
*> is being computed. WANTT is set to .false. otherwise.
*> \endverbatim
*>
*> \param[in] WANTZ
*> \verbatim
-*> WANTZ is logical scalar
+*> WANTZ is LOGICAL
*> WANTZ = .true. if the orthogonal Schur factor is being
*> computed. WANTZ is set to .false. otherwise.
*> \endverbatim
*>
*> \param[in] KACC22
*> \verbatim
-*> KACC22 is integer with value 0, 1, or 2.
+*> KACC22 is INTEGER with value 0, 1, or 2.
*> Specifies the computation mode of far-from-diagonal
*> orthogonal updates.
*> = 0: SLAQR5 does not accumulate reflections and does not
*>
*> \param[in] N
*> \verbatim
-*> N is integer scalar
+*> N is INTEGER
*> N is the order of the Hessenberg matrix H upon which this
*> subroutine operates.
*> \endverbatim
*>
*> \param[in] KTOP
*> \verbatim
-*> KTOP is integer scalar
+*> KTOP is INTEGER
*> \endverbatim
*>
*> \param[in] KBOT
*> \verbatim
-*> KBOT is integer scalar
+*> KBOT is INTEGER
*> These are the first and last rows and columns of an
*> isolated diagonal block upon which the QR sweep is to be
*> applied. It is assumed without a check that
*>
*> \param[in] NSHFTS
*> \verbatim
-*> NSHFTS is integer scalar
+*> NSHFTS is INTEGER
*> NSHFTS gives the number of simultaneous shifts. NSHFTS
*> must be positive and even.
*> \endverbatim
*>
*> \param[in,out] SR
*> \verbatim
-*> SR is REAL array of size (NSHFTS)
+*> SR is REAL array, dimension (NSHFTS)
*> \endverbatim
*>
*> \param[in,out] SI
*> \verbatim
-*> SI is REAL array of size (NSHFTS)
+*> SI is REAL array, dimension (NSHFTS)
*> SR contains the real parts and SI contains the imaginary
*> parts of the NSHFTS shifts of origin that define the
*> multi-shift QR sweep. On output SR and SI may be
*>
*> \param[in,out] H
*> \verbatim
-*> H is REAL array of size (LDH,N)
+*> H is REAL array, dimension (LDH,N)
*> On input H contains a Hessenberg matrix. On output a
*> multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
*> to the isolated diagonal block in rows and columns KTOP
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer scalar
+*> LDH is INTEGER
*> LDH is the leading dimension of H just as declared in the
*> calling procedure. LDH.GE.MAX(1,N).
*> \endverbatim
*>
*> \param[in,out] Z
*> \verbatim
-*> Z is REAL array of size (LDZ,IHIZ)
+*> Z is REAL array, dimension (LDZ,IHIZ)
*> If WANTZ = .TRUE., then the QR Sweep orthogonal
*> similarity transformation is accumulated into
*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right.
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer scalar
+*> LDZ is INTEGER
*> LDA is the leading dimension of Z just as declared in
*> the calling procedure. LDZ.GE.N.
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
-*> V is REAL array of size (LDV,NSHFTS/2)
+*> V is REAL array, dimension (LDV,NSHFTS/2)
*> \endverbatim
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> LDV is the leading dimension of V as declared in the
*> calling procedure. LDV.GE.3.
*> \endverbatim
*>
*> \param[out] U
*> \verbatim
-*> U is REAL array of size
-*> (LDU,3*NSHFTS-3)
+*> U is REAL array, dimension (LDU,3*NSHFTS-3)
*> \endverbatim
*>
*> \param[in] LDU
*> \verbatim
-*> LDU is integer scalar
+*> LDU is INTEGER
*> LDU is the leading dimension of U just as declared in the
*> in the calling subroutine. LDU.GE.3*NSHFTS-3.
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> NH is the number of columns in array WH available for
*> workspace. NH.GE.1.
*> \endverbatim
*>
*> \param[out] WH
*> \verbatim
-*> WH is REAL array of size (LDWH,NH)
+*> WH is REAL array, dimension (LDWH,NH)
*> \endverbatim
*>
*> \param[in] LDWH
*> \verbatim
-*> LDWH is integer scalar
+*> LDWH is INTEGER
*> Leading dimension of WH just as declared in the
*> calling procedure. LDWH.GE.3*NSHFTS-3.
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer scalar
+*> NV is INTEGER
*> NV is the number of rows in WV agailable for workspace.
*> NV.GE.1.
*> \endverbatim
*>
*> \param[out] WV
*> \verbatim
-*> WV is REAL array of size
-*> (LDWV,3*NSHFTS-3)
+*> WV is REAL array, dimension (LDWV,3*NSHFTS-3)
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer scalar
+*> LDWV is INTEGER
*> LDWV is the leading dimension of WV as declared in the
*> in the calling subroutine. LDWV.GE.NV.
*> \endverbatim
$ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U,
$ LDU, NV, WV, LDWV, NH, WH, LDWH )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realOTHERauxiliary
*
* =====================================================================
SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX, N
CALL SSCAL( N-1, RSAFMN, X, INCX )
BETA = BETA*RSAFMN
ALPHA = ALPHA*RSAFMN
- IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000)
+ IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) )
$ GO TO 10
*
* New BETA is at most 1, at least SAFMIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realOTHERauxiliary
*
* =====================================================================
SUBROUTINE SLARFGP( N, ALPHA, X, INCX, TAU )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX, N
CALL SSCAL( N-1, BIGNUM, X, INCX )
BETA = BETA*BIGNUM
ALPHA = ALPHA*BIGNUM
- IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000 )
+ IF( (ABS( BETA ).LT.SMLNUM) .AND. (KNT .LT. 20) )
$ GO TO 10
*
* New BETA is at most 1, at least SMLNUM
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
SUBROUTINE SLARRA( N, D, E, E2, SPLTOL, TNRM,
$ NSPLIT, ISPLIT, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, N, NSPLIT
* .. Executable Statements ..
*
INFO = 0
-
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
* Compute splitting points
NSPLIT = 1
IF(SPLTOL.LT.ZERO) THEN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
$ RTOL2, OFFSET, W, WGAP, WERR, WORK, IWORK,
$ PIVMIN, SPDIAM, TWIST, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IFIRST, ILAST, INFO, N, OFFSET, TWIST
*
INFO = 0
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
MAXITR = INT( ( LOG( SPDIAM+PIVMIN )-LOG( PIVMIN ) ) /
$ LOG( TWO ) ) + 2
MNWDTH = TWO * PIVMIN
SUBROUTINE SLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
$ EIGCNT, LCNT, RCNT, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. Executable Statements ..
*
INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
LCNT = 0
RCNT = 0
EIGCNT = 0
$ M, W, WERR, WL, WU, IBLOCK, INDEXW,
$ WORK, IWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
INFO = 0
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
* Decode RANGE
*
IF( LSAME( RANGE, 'A' ) ) THEN
$ W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN,
$ WORK, IWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SLARNV, SLARRA, SLARRB, SLARRC, SLARRD,
- $ SLASQ2
+ $ SLASQ2, SLARRK
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN
*
INFO = 0
-
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
*
* Decode RANGE
*
$ SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA,
$ DPLUS, LPLUS, WORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. Executable Statements ..
*
INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
FACT = REAL(2**KTRYMAX)
EPS = SLAMCH( 'Precision' )
SHIFT = 0
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
$ RTOL, OFFSET, W, WERR, WORK, IWORK,
$ PIVMIN, SPDIAM, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IFIRST, ILAST, INFO, N, OFFSET
*
INFO = 0
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
MAXITR = INT( ( LOG( SPDIAM+PIVMIN )-LOG( PIVMIN ) ) /
$ LOG( TWO ) ) + 2
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
SUBROUTINE SLARRK( N, IW, GL, GU,
$ D, E2, PIVMIN, RELTOL, W, WERR, INFO)
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, IW, N
* ..
* .. Executable Statements ..
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ INFO = 0
+ RETURN
+ END IF
+*
* Get machine constants
EPS = SLAMCH( 'P' )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
* =====================================================================
SUBROUTINE SLARRR( N, D, E, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER N, INFO
* ..
* .. Executable Statements ..
*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ INFO = 0
+ RETURN
+ END IF
+*
* As a default, do NOT go for relative-accuracy preserving computations.
INFO = 1
*> \verbatim
*> VU is REAL
*> Upper bound of the interval that contains the desired
-*> eigenvalues. VL < VU. Needed to compute gaps on the left or right
-*> end of the extremal eigenvalues in the desired RANGE.
+*> eigenvalues. VL < VU.
+*> Note: VU is currently not used by this implementation of SLARRV, VU is
+*> passed to SLARRV because it could be used compute gaps on the right end
+*> of the extremal eigenvalues. However, with not much initial accuracy in
+*> LAMBDA and VU, the formula can lead to an overestimation of the right gap
+*> and thus to inadequately early RQI 'convergence'. This is currently
+*> prevented this by forcing a small right gap. And so it turns out that VU
+*> is currently not used by this implementation of SLARRV.
*> \endverbatim
*>
*> \param[in,out] D
$ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ,
$ WORK, IWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
* The first N entries of WORK are reserved for the eigenvalues
INDLD = N+1
INDLLD= 2*N+1
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup auxOTHERcomputational
*
* =====================================================================
SUBROUTINE SLARTGS( X, Y, SIGMA, CS, SN )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
REAL CS, SIGMA, SN, X, Y
* .. Local Scalars ..
REAL R, S, THRESH, W, Z
* ..
+* .. External Subroutines ..
+ EXTERNAL SLARTGP
+* ..
* .. External Functions ..
REAL SLAMCH
EXTERNAL SLAMCH
*>
*> \param[out] U
*> \verbatim
-*> U is REAL array, dimension at least (LDQ, N)
+*> U is REAL array, dimension (LDU, N)
*> On exit, U contains the left singular vectors.
*> \endverbatim
*>
*>
*> \param[out] VT
*> \verbatim
-*> VT is REAL array, dimension at least (LDVT, M)
+*> VT is REAL array, dimension (LDVT, M)
*> On exit, VT**T contains the right singular vectors.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
SUBROUTINE SLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
$ WORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
*>
*> \param[out] Q
*> \verbatim
-*> Q is REAL array,
-*> dimension at least (LDQ,K).
+*> Q is REAL array, dimension (LDQ,K)
*> \endverbatim
*>
*> \param[in] LDQ
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
$ LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z,
$ INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, K, LDQ, LDU, LDU2, LDVT, LDVT2, NL, NR,
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension at least 3 * K
+*> WORK is REAL array, dimension (3*K)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup OTHERauxiliary
*
SUBROUTINE SLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR,
$ DSIGMA, WORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER ICOMPQ, INFO, K, LDDIFR
SUBROUTINE SLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
$ DN1, DN2, TAU, TTYPE, G )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
NP = NN - 9
ELSE
NP = NN - 2*PP
- B2 = Z( NP-2 )
GAM = DN1
IF( Z( NP-4 ) .GT. Z( NP-2 ) )
$ RETURN
*> \verbatim
*> A is REAL array, dimension (LDA,N)
*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and bleow the diagonal
+*> On exit, the elements on and below the diagonal
*> of the array contain the N-by-N lower triangular matrix L;
*> the elements above the diagonal represent Q by the rows
*> of blocked V (see Further Details).
SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
$ INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
LOGICAL LSAME
EXTERNAL LSAME
* .. EXTERNAL SUBROUTINES ..
- EXTERNAL SGEQRT, STPQRT, XERBLA
+ EXTERNAL SGELQT, SGEQRT, STPLQT, STPQRT, XERBLA
* .. INTRINSIC FUNCTIONS ..
INTRINSIC MAX, MIN, MOD
* ..
*> \verbatim
*> IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
*> The vector of pivot indices. Only the elements in positions
-*> K1 through K1+(K2-K1)*INCX of IPIV are accessed.
-*> IPIV(K) = L implies rows K and L are to be interchanged.
+*> K1 through K1+(K2-K1)*abs(INCX) of IPIV are accessed.
+*> IPIV(K1+(K-K1)*abs(INCX)) = L implies rows K and L are to be
+*> interchanged.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
-*> The increment between successive values of IPIV. If IPIV
+*> The increment between successive values of IPIV. If INCX
*> is negative, the pivots are applied in reverse order.
*> \endverbatim
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERauxiliary
*
* =====================================================================
SUBROUTINE SLASWP( N, A, LDA, K1, K2, IPIV, INCX )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INCX, K1, K2, LDA, N
* ..
* .. Executable Statements ..
*
-* Interchange row I with row IPIV(I) for each of rows K1 through K2.
+* Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
+* K1 through K2.
*
IF( INCX.GT.0 ) THEN
IX0 = K1
* ===========
*
* SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-* H, LDH, WORK, INFO )
+* H, LDH, WORK )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
-* INTEGER J1, M, NB, LDA, LDH, INFO
+* INTEGER J1, M, NB, LDA, LDH
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[out] IPIV
*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
+*> IPIV is INTEGER array, dimension (M)
*> Details of the row and column interchanges,
*> the row and column k were interchanged with the row and
*> column IPIV(k).
*> WORK is REAL workspace, dimension (M).
*> \endverbatim
*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
*
* Authors:
* ========
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYcomputational
*
* =====================================================================
SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
- $ H, LDH, WORK, INFO )
+ $ H, LDH, WORK )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
* .. Scalar Arguments ..
CHARACTER UPLO
- INTEGER M, NB, J1, LDA, LDH, INFO
+ INTEGER M, NB, J1, LDA, LDH
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
*
* .. Local Scalars ..
- INTEGER J, K, K1, I1, I2
+ INTEGER J, K, K1, I1, I2, MJ
REAL PIV, ALPHA
* ..
* .. External Functions ..
EXTERNAL LSAME, ILAENV, ISAMAX
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL SAXPY, SGEMV, SSCAL, SCOPY, SSWAP, SLASET,
+ $ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
* ..
* .. Executable Statements ..
*
- INFO = 0
J = 1
*
* K1 is the first column of the panel to be factorized
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
-* H(J:N, J) := A(J, J:N) - H(J:N, 1:(J-1)) * L(J1:(J-1), J),
-* where H(J:N, J) has been initialized to be A(J, J:N)
+* H(J:M, J) := A(J, J:M) - H(J:M, 1:(J-1)) * L(J1:(J-1), J),
+* where H(J:M, J) has been initialized to be A(J, J:M)
*
IF( K.GT.2 ) THEN
*
* > for the rest of the columns, K is J+1, skipping only the
* first column
*
- CALL SGEMV( 'No transpose', M-J+1, J-K1,
+ CALL SGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( 1, J ), 1,
$ ONE, H( J, J ), 1 )
END IF
*
-* Copy H(i:n, i) into WORK
+* Copy H(i:M, i) into WORK
*
- CALL SCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL SCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
-* Compute WORK := WORK - L(J-1, J:N) * T(J-1,J),
-* where A(J-1, J) stores T(J-1, J) and A(J-2, J:N) stores U(J-1, J:N)
+* Compute WORK := WORK - L(J-1, J:M) * T(J-1,J),
+* where A(J-1, J) stores T(J-1, J) and A(J-2, J:M) stores U(J-1, J:M)
*
ALPHA = -A( K-1, J )
- CALL SAXPY( M-J+1, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
+ CALL SAXPY( MJ, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
*
IF( J.LT.M ) THEN
*
-* Compute WORK(2:N) = T(J, J) L(J, (J+1):N)
-* where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N)
+* Compute WORK(2:M) = T(J, J) L(J, (J+1):M)
+* where A(J, J) stores T(J, J) and A(J-1, (J+1):M) stores U(J, (J+1):M)
*
IF( K.GT.1 ) THEN
ALPHA = -A( K, J )
$ WORK( 2 ), 1 )
ENDIF
*
-* Find max(|WORK(2:n)|)
+* Find max(|WORK(2:M)|)
*
I2 = ISAMAX( M-J, WORK( 2 ), 1 ) + 1
PIV = WORK( I2 )
WORK( I2 ) = WORK( I1 )
WORK( I1 ) = PIV
*
-* Swap A(I1, I1+1:N) with A(I1+1:N, I2)
+* Swap A(I1, I1+1:M) with A(I1+1:M, I2)
*
I1 = I1+J-1
I2 = I2+J-1
CALL SSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA,
$ A( J1+I1, I2 ), 1 )
*
-* Swap A(I1, I2+1:N) with A(I2, I2+1:N)
+* Swap A(I1, I2+1:M) with A(I2, I2+1:M)
*
CALL SSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
$ A( J1+I2-1, I2+1 ), LDA )
* Set A(J, J+1) = T(J, J+1)
*
A( K, J+1 ) = WORK( 2 )
- IF( (A( K, J ).EQ.ZERO ) .AND.
- $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
- IF(INFO .EQ. 0) THEN
- INFO = J
- ENDIF
- END IF
*
IF( J.LT.NB ) THEN
*
-* Copy A(J+1:N, J+1) into H(J:N, J),
+* Copy A(J+1:M, J+1) into H(J:M, J),
*
CALL SCOPY( M-J, A( K+1, J+1 ), LDA,
$ H( J+1, J+1 ), 1 )
END IF
*
-* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
-* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
+* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
*
IF( A( K, J+1 ).NE.ZERO ) THEN
ALPHA = ONE / A( K, J+1 )
CALL SLASET( 'Full', 1, M-J-1, ZERO, ZERO,
$ A( K, J+2 ), LDA)
END IF
- ELSE
- IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 10
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
-* H(J:N, J) := A(J:N, J) - H(J:N, 1:(J-1)) * L(J, J1:(J-1))^T,
-* where H(J:N, J) has been initialized to be A(J:N, J)
+* H(J:M, J) := A(J:M, J) - H(J:M, 1:(J-1)) * L(J, J1:(J-1))^T,
+* where H(J:M, J) has been initialized to be A(J:M, J)
*
IF( K.GT.2 ) THEN
*
* > for the rest of the columns, K is J+1, skipping only the
* first column
*
- CALL SGEMV( 'No transpose', M-J+1, J-K1,
+ CALL SGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( J, 1 ), LDA,
$ ONE, H( J, J ), 1 )
END IF
*
-* Copy H(J:N, J) into WORK
+* Copy H(J:M, J) into WORK
*
- CALL SCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL SCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
-* Compute WORK := WORK - L(J:N, J-1) * T(J-1,J),
+* Compute WORK := WORK - L(J:M, J-1) * T(J-1,J),
* where A(J-1, J) = T(J-1, J) and A(J, J-2) = L(J, J-1)
*
ALPHA = -A( J, K-1 )
- CALL SAXPY( M-J+1, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
+ CALL SAXPY( MJ, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
*
IF( J.LT.M ) THEN
*
-* Compute WORK(2:N) = T(J, J) L((J+1):N, J)
-* where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J)
+* Compute WORK(2:M) = T(J, J) L((J+1):M, J)
+* where A(J, J) = T(J, J) and A((J+1):M, J-1) = L((J+1):M, J)
*
IF( K.GT.1 ) THEN
ALPHA = -A( J, K )
$ WORK( 2 ), 1 )
ENDIF
*
-* Find max(|WORK(2:n)|)
+* Find max(|WORK(2:M)|)
*
I2 = ISAMAX( M-J, WORK( 2 ), 1 ) + 1
PIV = WORK( I2 )
WORK( I2 ) = WORK( I1 )
WORK( I1 ) = PIV
*
-* Swap A(I1+1:N, I1) with A(I2, I1+1:N)
+* Swap A(I1+1:M, I1) with A(I2, I1+1:M)
*
I1 = I1+J-1
I2 = I2+J-1
CALL SSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1,
$ A( I2, J1+I1 ), LDA )
*
-* Swap A(I2+1:N, I1) with A(I2+1:N, I2)
+* Swap A(I2+1:M, I1) with A(I2+1:M, I2)
*
CALL SSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
$ A( I2+1, J1+I2-1 ), 1 )
* Set A(J+1, J) = T(J+1, J)
*
A( J+1, K ) = WORK( 2 )
- IF( (A( J, K ).EQ.ZERO) .AND.
- $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
- IF (INFO .EQ. 0)
- $ INFO = J
- END IF
*
IF( J.LT.NB ) THEN
*
-* Copy A(J+1:N, J+1) into H(J+1:N, J),
+* Copy A(J+1:M, J+1) into H(J+1:M, J),
*
CALL SCOPY( M-J, A( J+1, K+1 ), 1,
$ H( J+1, J+1 ), 1 )
END IF
*
-* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
-* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
+* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
*
IF( A( J+1, K ).NE.ZERO ) THEN
ALPHA = ONE / A( J+1, K )
CALL SLASET( 'Full', M-J-1, 1, ZERO, ZERO,
$ A( J+2, K ), LDA )
END IF
- ELSE
- IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 30
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
$ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE SORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
$ LDQ2, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE SORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
$ LDQ2, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*>
*> \param[out] U1
*> \verbatim
-*> U1 is REAL array, dimension (P)
+*> U1 is REAL array, dimension (LDU1,P)
*> If JOBU1 = 'Y', U1 contains the P-by-P orthogonal matrix U1.
*> \endverbatim
*>
*>
*> \param[out] U2
*> \verbatim
-*> U2 is REAL array, dimension (M-P)
+*> U2 is REAL array, dimension (LDU2,M-P)
*> If JOBU2 = 'Y', U2 contains the (M-P)-by-(M-P) orthogonal
*> matrix U2.
*> \endverbatim
*>
*> \param[out] V1T
*> \verbatim
-*> V1T is REAL array, dimension (Q)
+*> V1T is REAL array, dimension (LDV1T,Q)
*> If JOBV1T = 'Y', V1T contains the Q-by-Q matrix orthogonal
*> matrix V1**T.
*> \endverbatim
*>
*> \param[out] V2T
*> \verbatim
-*> V2T is REAL array, dimension (M-Q)
+*> V2T is REAL array, dimension (LDV2T,M-Q)
*> If JOBV2T = 'Y', V2T contains the (M-Q)-by-(M-Q) orthogonal
*> matrix V2**T.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERcomputational
*
$ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T,
$ LDV2T, WORK, LWORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, SIGNS, TRANS
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
$ X21, LDX21, THETA, U1, LDU1, U2, LDU2, V1T,
$ LDV1T, WORK, LWORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*> N2-by-N2 upper triangular matrix.
*> \endverbatim
*
-* Arguments
-* =========
+* Arguments:
+* ==========
*
*> \param[in] SIDE
*> \verbatim
SUBROUTINE SORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.6.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2015
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realPOcomputational
*
* =====================================================================
RECURSIVE SUBROUTINE SPOTRF2( UPLO, N, A, LDA, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, SISNAN
* ..
* .. External Subroutines ..
- EXTERNAL SSYRK, XERBLA
+ EXTERNAL SSYRK, STRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, SQRT
*>
*> \param[in,out] AFP
*> \verbatim
-*> AFP is REAL array, dimension
-*> (N*(N+1)/2)
+*> AFP is REAL array, dimension (N*(N+1)/2)
*> If FACT = 'F', then AFP is an input argument and on entry
*> contains the triangular factor U or L from the Cholesky
*> factorization A = U**T*U or A = L*L**T, in the same storage
SUBROUTINE SPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB,
$ X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* Arguments:
* ==========
*
-*> @param[in] n
-*> The order of the matrix A.
-*>
-*> @param[in] nb
-*> The size of the band.
-*>
-*> @param[in, out] A
-*> A pointer to the matrix A.
-*>
-*> @param[in] lda
-*> The leading dimension of the matrix A.
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> \endverbatim
*>
-*> @param[out] V
-*> REAL array, dimension 2*n if eigenvalues only are
-*> requested or to be queried for vectors.
+*> \param[in] WANTZ
+*> \verbatim
+*> WANTZ is LOGICAL which indicate if Eigenvalue are requested or both
+*> Eigenvalue/Eigenvectors.
+*> \endverbatim
*>
-*> @param[out] TAU
-*> REAL array, dimension (2*n).
-*> The scalar factors of the Householder reflectors are stored
-*> in this array.
+*> \param[in] TTYPE
+*> \verbatim
+*> TTYPE is INTEGER
+*> \endverbatim
*>
-*> @param[in] st
+*> \param[in] ST
+*> \verbatim
+*> ST is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] ed
+*> \param[in] ED
+*> \verbatim
+*> ED is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] sweep
+*> \param[in] SWEEP
+*> \verbatim
+*> SWEEP is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] Vblksiz
-*> internal parameter for indices.
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER. The order of the matrix A.
+*> \endverbatim
*>
-*> @param[in] wantz
-*> logical which indicate if Eigenvalue are requested or both
-*> Eigenvalue/Eigenvectors.
+*> \param[in] NB
+*> \verbatim
+*> NB is INTEGER. The size of the band.
+*> \endverbatim
+*>
+*> \param[in] IB
+*> \verbatim
+*> IB is INTEGER.
+*> \endverbatim
+*>
+*> \param[in, out] A
+*> \verbatim
+*> A is REAL array. A pointer to the matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER. The leading dimension of the matrix A.
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*> V is REAL array, dimension 2*n if eigenvalues only are
+*> requested or to be queried for vectors.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is REAL array, dimension (2*n).
+*> The scalar factors of the Householder reflectors are stored
+*> in this array.
+*> \endverbatim
+*>
+*> \param[in] LDVT
+*> \verbatim
+*> LDVT is INTEGER.
+*> \endverbatim
+*>
+*> \param[in] WORK
+*> \verbatim
+*> WORK is REAL array. Workspace of size nb.
+*> \endverbatim
+*> @param[in] n
+*> The order of the matrix A.
*>
-*> @param[in] work
-*> Workspace of size nb.
*>
*> \par Further Details:
* =====================
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realOTHEReigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, SLANSB
- EXTERNAL LSAME, SLAMCH, SLANSB, ILAENV
+ EXTERNAL LSAME, SLAMCH, SLANSB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SLASCL, SSCAL, SSTEQR, SSTERF, XERBLA,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- IB = ILAENV( 18, 'SSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
ENDIF
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realOTHEReigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, SLANSB
- EXTERNAL LSAME, SLAMCH, SLANSB, ILAENV
+ EXTERNAL LSAME, SLAMCH, SLANSB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SGEMM, SLACPY, SLASCL, SSCAL, SSTEDC,
LIWMIN = 1
LWMIN = 1
ELSE
- IB = ILAENV( 18, 'SSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
IF( WANTZ ) THEN
LIWMIN = 3 + 5*N
LWMIN = 1 + 5*N + 2*N**2
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, SLANSB
- EXTERNAL LSAME, SLAMCH, SLANSB, ILAENV
+ EXTERNAL LSAME, SLAMCH, SLANSB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SGEMV, SLACPY, SLASCL, SSCAL,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- IB = ILAENV( 18, 'SSYTRD_SB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = 2*N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
ENDIF
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension (7N)
+*> WORK is REAL array, dimension (7*N)
*> \endverbatim
*>
*> \param[out] IWORK
*> \verbatim
-*> IWORK is INTEGER array, dimension (5N)
+*> IWORK is INTEGER array, dimension (5*N)
*> \endverbatim
*>
*> \param[out] IFAIL
$ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
$ LDZ, WORK, IWORK, IFAIL, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[in] A
*> \verbatim
-*> A is REAL array of DIMENSION (LDA,ka)
+*> A is REAL array, dimension (LDA,ka)
*> where KA
*> is K when TRANS = 'N' or 'n', and is N otherwise. Before
*> entry with TRANS = 'N' or 'n', the leading N--by--K part of
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERcomputational
*
SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
$ C )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
REAL ALPHA, BETA
*>
*> \param[in,out] AP
*> \verbatim
-*> AP is REAL array, dimension
-*> (N*(N+1)/2)
+*> AP is REAL array, dimension (N*(N+1)/2)
*> On entry, the upper or lower triangle of the symmetric matrix
*> A, packed columnwise in a linear array. The j-th column of A
*> is stored in the array AP as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHEReigen
*
SUBROUTINE SSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK,
$ INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
*>
*> \param[in,out] AFP
*> \verbatim
-*> AFP is REAL array, dimension
-*> (N*(N+1)/2)
+*> AFP is REAL array, dimension (N*(N+1)/2)
*> If FACT = 'F', then AFP is an input argument and on entry
*> contains the block diagonal matrix D and the multipliers used
*> to obtain the factor U or L from the factorization
SUBROUTINE SSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X,
$ LDX, RCOND, FERR, BERR, WORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*>
*> \param[out] ISUPPZ
*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
+*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
*> The support of the eigenvectors in Z, i.e., the indices
*> indicating the nonzero elements in Z. The i-th computed eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
$ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[out] ISUPPZ
*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
+*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
*> The support of the eigenvectors in Z, i.e., the indices
*> indicating the nonzero elements in Z. The i-th computed eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
$ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK,
$ IWORK, LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup singleSYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE SSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
$ WORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* Definition:
* ===========
*
-* SUBROUTINE SSYCONVF( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+* SUBROUTINE SSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup singleSYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE SSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO, WAY
* Definition:
* ===========
*
-* SUBROUTINE SSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+* SUBROUTINE SSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup singleSYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE SSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYcomputational
*
* =====================================================================
SUBROUTINE SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, N
EXTERNAL LSAME, SLAMCH
* ..
* .. External Subroutines ..
- EXTERNAL SLASSQ
+ EXTERNAL SLASSQ, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, INT, LOG, MAX, MIN, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, SLANSY
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANSY
+ EXTERNAL LSAME, SLAMCH, SLANSY, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SLASCL, SORGTR, SSCAL, SSTEQR, SSTERF,
END IF
*
IF( INFO.EQ.0 ) THEN
- KD = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = 2*N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, SLANSY
- EXTERNAL LSAME, SLAMCH, SLANSY, ILAENV
+ EXTERNAL LSAME, SLAMCH, SLANSY, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SLACPY, SLASCL, SORMTR, SSCAL, SSTEDC, SSTERF,
LIWMIN = 1
LWMIN = 1
ELSE
- KD = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ,
+ $ N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
IF( WANTZ ) THEN
LIWMIN = 3 + 5*N
LWMIN = 1 + 6*N + 2*N**2
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV, ILAENV2STAGE
REAL SLAMCH, SLANSY
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANSY
+ EXTERNAL LSAME, SLAMCH, SLANSY, ILAENV, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SORMTR, SSCAL, SSTEBZ, SSTEMR, SSTEIN,
*
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) )
*
- KD = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD )
LIWMIN = MAX( 1, 10*N )
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
REAL SLAMCH, SLANSY
- EXTERNAL LSAME, ILAENV, SLAMCH, SLANSY
+ EXTERNAL LSAME, SLAMCH, SLANSY, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SLACPY, SORGTR, SORMTR, SSCAL, SSTEBZ,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- KD = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ,
+ $ N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = MAX( 8*N, 3*N + LHTRD + LWTRD )
WORK( 1 ) = LWMIN
END IF
*> positive definite.
*> This routine use the 2stage technique for the reduction to tridiagonal
*> which showed higher performance on recent architecture and for large
-* sizes N>2000.
+*> sizes N>2000.
*> \endverbatim
*
* Arguments:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* .. Local Scalars ..
LOGICAL LQUERY, UPPER, WANTZ
CHARACTER TRANS
- INTEGER NEIG,
- $ LLWORK, LWMIN, LHTRD, LWTRD, KD, IB, INDHOUS
+ INTEGER NEIG, LWMIN, LHTRD, LWTRD, KD, IB
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ INTEGER ILAENV2STAGE
+ EXTERNAL LSAME, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL SPOTRF, SSYGST, STRMM, STRSM, XERBLA,
END IF
*
IF( INFO.EQ.0 ) THEN
- KD = ILAENV( 17, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = 2*N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
*
*>
*> \param[in,out] B
*> \verbatim
-*> B is REAL array, dimension (LDA, N)
+*> B is REAL array, dimension (LDB, N)
*> On entry, the symmetric matrix B. If UPLO = 'U', the
*> leading N-by-N upper triangular part of B contains the
*> upper triangular part of the matrix B. If UPLO = 'L',
$ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
$ LWORK, IWORK, IFAIL, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYsolve
*
SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, SSYTRF, SSYTRS, SSYTRS2
+ EXTERNAL XERBLA, SSYTRS_AA, SSYTRF_AA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief <b> SSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYSV_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssysv_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssysv_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssysv_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+* IPIV, IPIV2, B, LDB, WORK, LWORK,
+* INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* REAL A( LDA, * ), TB( * ), B( LDB, *), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SSYSV_AA_2STAGE computes the solution to a real system of
+*> linear equations
+*> A * X = B,
+*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+*> matrices.
+*>
+*> Aasen's 2-stage algorithm is used to factor A as
+*> A = U * T * U**T, if UPLO = 'U', or
+*> A = L * T * L**T, if UPLO = 'L',
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is symmetric and band. The matrix T is
+*> then LU-factored with partial pivoting. The factored form of A
+*> is then used to solve the system of equations A * X = B.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is REAL array, dimension (LDA,N)
+*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is REAL array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is REAL array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup realSYsolve
+*
+* =====================================================================
+ SUBROUTINE SSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, WORK, LWORK,
+ $ INFO )
+*
+* -- LAPACK driver routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LDB, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ REAL A( LDA, * ), B( LDB, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+* ..
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER LWKOPT
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL SSYTRF_AA_2STAGE, SSYTRS_AA_2STAGE,
+ $ XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
+ $ IPIV2, WORK, -1, INFO )
+ LWKOPT = INT( WORK(1) )
+ IF( LTB.LT.INT( TB(1) ) .AND. .NOT.TQUERY ) THEN
+ INFO = -7
+ ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.WQUERY ) THEN
+ INFO = -13
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SSYSV_AA_2STAGE', -INFO )
+ RETURN
+ ELSE IF( WQUERY .OR. TQUERY ) THEN
+ RETURN
+ END IF
+*
+*
+* Compute the factorization A = U*T*U**T or A = L*T*L**T.
+*
+ CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
+ $ WORK, LWORK, INFO )
+ IF( INFO.EQ.0 ) THEN
+*
+* Solve the system A*X = B, overwriting B with X.
+*
+ CALL SSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, B, LDB, INFO )
+*
+ END IF
+*
+ WORK( 1 ) = LWKOPT
+*
+ RETURN
+*
+* End of SSYSV_AA_2STAGE
+*
+ END
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension LWORK.
+*> WORK is REAL array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYcomputational
*
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER VECT, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ INTEGER ILAENV2STAGE
+ EXTERNAL LSAME, ILAENV2STAGE
* ..
* .. Executable Statements ..
*
*
* Determine the block size, the workspace size and the hous size.
*
- KD = ILAENV( 17, 'SSYTRD_2STAGE', VECT, N, -1, -1, -1 )
- IB = ILAENV( 18, 'SSYTRD_2STAGE', VECT, N, KD, -1, -1 )
- LHMIN = ILAENV( 19, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 )
- LWMIN = ILAENV( 20, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', VECT, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', VECT, N, KD, -1, -1 )
+ LHMIN = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 )
+ LWMIN = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 )
* WRITE(*,*),'SSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
* $ LHMIN, LWMIN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup real16OTHERcomputational
*
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER STAGE1, UPLO, VECT
$ SISEV, SIZETAU, LDV, LHMIN, LWMIN
* ..
* .. External Subroutines ..
- EXTERNAL SSB2ST_KERNELS, SLACPY, SLASET
+ EXTERNAL SSB2ST_KERNELS, SLACPY, SLASET, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MIN, MAX, CEILING, REAL
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension LWORK.
+*> WORK is REAL array, dimension (LWORK)
*> On exit, if INFO = 0, or if LWORK=-1,
*> WORK(1) returns the size of LWORK.
*> \endverbatim
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK which should be calculated
-* by a workspace query. LWORK = MAX(1, LWORK_QUERY)
+*> by a workspace query. LWORK = MAX(1, LWORK_QUERY)
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYcomputational
*
*>
*> where tau is a real scalar, and v is a real vector with
*> v(kd+1:i) = 0 and v(i+kd+1) = 1; v(i+kd+2:n) is stored on exit in
-* A(i+kd+2:n,i), and tau in TAU(i).
+*> A(i+kd+2:n,i), and tau in TAU(i).
*>
*> The contents of A on exit are illustrated by the following examples
*> with n = 5:
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
$ TPOS, WPOS, S2POS, S1POS
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, SSYR2K, SSYMM, SGEMM,
+ EXTERNAL XERBLA, SSYR2K, SSYMM, SGEMM, SCOPY,
$ SLARFT, SGELQF, SGEQRF, SLASET
* ..
* .. Intrinsic Functions ..
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYcomputational
*
* =====================================================================
SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
*
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
- INTEGER J, LWKOPT, IINFO
+ INTEGER J, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
REAL ALPHA
* ..
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL SLASYF_AA, SGEMV, SSCAL, SCOPY, SSWAP, SGEMM,
+ $ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*
* Determine the block size
*
- NB = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 )
+ NB = ILAENV( 1, 'SSYTRF_AA', UPLO, N, -1, -1, -1 )
*
* Test the input parameters.
*
ENDIF
IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN
- IF ( A( 1, 1 ).EQ.ZERO ) THEN
- INFO = 1
- END IF
RETURN
END IF
*
-* Adjubst block size based on the workspace size
+* Adjust block size based on the workspace size
*
IF( LWORK.LT.((1+NB)*N) ) THEN
NB = ( LWORK-N ) / N
*
CALL SLASYF_AA( UPLO, 2-K1, N-J, JB,
$ A( MAX(1, J), J+1 ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
- $ IINFO )
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
*
CALL SLASYF_AA( UPLO, 2-K1, N-J, JB,
$ A( J+1, MAX(1, J) ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
--- /dev/null
+*> \brief \b SSYTRF_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYTRF_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrf_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrf_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrf_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+* IPIV2, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* REAL A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SSYTRF_AA_2STAGE computes the factorization of a real symmetric matrix A
+*> using the Aasen's algorithm. The form of the factorization is
+*>
+*> A = U*T*U**T or A = L*T*L**T
+*>
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is a symmetric band matrix with the
+*> bandwidth of NB (NB is internally selected and stored in TB( 1 ), and T is
+*> LU factorized with partial pivoting).
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is REAL array, dimension (LDA,N)
+*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is REAL array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup realSYcomputational
+*
+* =====================================================================
+ SUBROUTINE SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, WORK, LWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ REAL A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER I, J, K, I1, I2, TD
+ INTEGER LDTB, NB, KB, JB, NT, IINFO
+ REAL PIV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, SCOPY, SLACGV, SLACPY,
+ $ SLASET, SGBTRF, SGEMM, SGETRF,
+ $ SSYGST, SSWAP, STRSM
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN
+ INFO = -6
+ ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN
+ INFO = -10
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SSYTRF_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Answer the query
+*
+ NB = ILAENV( 1, 'SSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
+ IF( INFO.EQ.0 ) THEN
+ IF( TQUERY ) THEN
+ TB( 1 ) = (3*NB+1)*N
+ END IF
+ IF( WQUERY ) THEN
+ WORK( 1 ) = N*NB
+ END IF
+ END IF
+ IF( TQUERY .OR. WQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return
+*
+ IF ( N.EQ.0 ) THEN
+ RETURN
+ ENDIF
+*
+* Determine the number of the block size
+*
+ LDTB = LTB/N
+ IF( LDTB .LT. 3*NB+1 ) THEN
+ NB = (LDTB-1)/3
+ END IF
+ IF( LWORK .LT. NB*N ) THEN
+ NB = LWORK/N
+ END IF
+*
+* Determine the number of the block columns
+*
+ NT = (N+NB-1)/NB
+ TD = 2*NB
+ KB = MIN(NB, N)
+*
+* Initialize vectors/matrices
+*
+ DO J = 1, KB
+ IPIV( J ) = J
+ END DO
+*
+* Save NB
+*
+ TB( 1 ) = NB
+*
+ IF( UPPER ) THEN
+*
+* .....................................................
+* Factorize A as L*D*L**T using the upper triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*U(I,J) + T(I+1,I)*U(I+1,J)
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL SGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( (I-1)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*U(I-1,J) + T(I,I)*U(I,J) + T(I,I+1)*U(I+1,J)
+ IF( I .EQ. J-1) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL SGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (I-2)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL SLACPY( 'Upper', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = U(1:J,J)'*H(1:J)
+ CALL SGEMM( 'Transpose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -ONE, A( 1, J*NB+1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += U(J,J)'*T(J,J-1)*U(J-1,J)
+ CALL SGEMM( 'Transpose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ ONE, A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ ZERO, WORK( 1 ), N )
+ CALL SGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB,
+ $ -ONE, WORK( 1 ), N,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+ IF( J.GT.0 ) THEN
+ CALL SSYGST( 1, 'Upper', KB,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA, IINFO )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ $ = TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL SGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, KB,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL SGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB+KB,
+ $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL SGEMM( 'Transpose', 'NoTranspose',
+ $ NB, N-(J+1)*NB, J*NB,
+ $ -ONE, WORK( NB+1 ), N,
+ $ A( 1, (J+1)*NB+1 ), LDA,
+ $ ONE, A( J*NB+1, (J+1)*NB+1 ), LDA )
+ END IF
+*
+* Copy panel to workspace to call SGETRF
+*
+ DO K = 1, NB
+ CALL SCOPY( N-(J+1)*NB,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA,
+ $ WORK( 1+(K-1)*N ), 1 )
+ END DO
+*
+* Factorize panel
+*
+ CALL SGETRF( N-(J+1)*NB, NB,
+ $ WORK, N,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Copy panel back
+*
+ DO K = 1, NB
+ CALL SCOPY( N-(J+1)*NB,
+ $ WORK( 1+(K-1)*N ), 1,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA )
+ END DO
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL SLASET( 'Full', KB, NB, ZERO, ZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL SLACPY( 'Upper', KB, NB,
+ $ WORK, N,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL STRSM( 'R', 'U', 'N', 'U', KB, NB, ONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J,J+1) into T(J+1, J), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB )
+ $ = TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ CALL SLASET( 'Lower', KB, NB, ZERO, ONE,
+ $ A( J*NB+1, (J+1)*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL SSWAP( K-1, A( (J+1)*NB+1, I1 ), 1,
+ $ A( (J+1)*NB+1, I2 ), 1 )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL SSWAP( I2-I1-1, A( I1, I1+1 ), LDA,
+ $ A( I1+1, I2 ), 1 )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL SSWAP( N-I2, A( I1, I2+1 ), LDA,
+ $ A( I2, I2+1 ), LDA )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL SSWAP( J*NB, A( 1, I1 ), 1,
+ $ A( 1, I2 ), 1 )
+ END IF
+ ENDIF
+ END DO
+ END IF
+ END DO
+ ELSE
+*
+* .....................................................
+* Factorize A as L*D*L**T using the lower triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*L(J,I)' + T(I+1,I)'*L(J,I+1)'
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL SGEMM( 'NoTranspose', 'Transpose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (I-1)*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*L(J,I-1)' + T(I,I)*L(J,I)' + T(I,I+1)*L(J,I+1)'
+ IF( I .EQ. J-1) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL SGEMM( 'NoTranspose', 'Transpose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (I-2)*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL SLACPY( 'Lower', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = L(J,1:J)*H(1:J)
+ CALL SGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -ONE, A( J*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += L(J,J)*T(J,J-1)*L(J,J-1)'
+ CALL SGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ ONE, A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ ZERO, WORK( 1 ), N )
+ CALL SGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, NB,
+ $ -ONE, WORK( 1 ), N,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+ IF( J.GT.0 ) THEN
+ CALL SSYGST( 1, 'Lower', KB,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA, IINFO )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ $ = TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL SGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, KB,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL SGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, NB+KB,
+ $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL SGEMM( 'NoTranspose', 'NoTranspose',
+ $ N-(J+1)*NB, NB, J*NB,
+ $ -ONE, A( (J+1)*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, A( (J+1)*NB+1, J*NB+1 ), LDA )
+ END IF
+*
+* Factorize panel
+*
+ CALL SGETRF( N-(J+1)*NB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL SLASET( 'Full', KB, NB, ZERO, ZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL SLACPY( 'Upper', KB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL STRSM( 'R', 'L', 'T', 'U', KB, NB, ONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J+1,J) into T(J, J+1), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB ) =
+ $ TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ CALL SLASET( 'Upper', KB, NB, ZERO, ONE,
+ $ A( (J+1)*NB+1, J*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL SSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA,
+ $ A( I2, (J+1)*NB+1 ), LDA )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL SSWAP( I2-I1-1, A( I1+1, I1 ), 1,
+ $ A( I2, I1+1 ), LDA )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL SSWAP( N-I2, A( I2+1, I1 ), 1,
+ $ A( I2+1, I2 ), 1 )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL SSWAP( J*NB, A( I1, 1 ), LDA,
+ $ A( I2, 1 ), LDA )
+ END IF
+ ENDIF
+ END DO
+*
+* Apply pivots to previous columns of L
+*
+c CALL SLASWP( J*NB, A( 1, 1 ), LDA,
+c $ (J+1)*NB+1, (J+1)*NB+KB, IPIV, 1 )
+ END IF
+ END DO
+ END IF
+*
+* Factor the band matrix
+ CALL SGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO )
+*
+* End of SSYTRF_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYcomputational
*
* =====================================================================
SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL SSYTRI, SSYTRI2X
+ EXTERNAL SSYTRI, SSYTRI2X, XERBLA
* ..
* .. Executable Statements ..
*
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension (N+NNB+1,NNB+3)
+*> WORK is REAL array, dimension (N+NB+1,NB+3)
*> \endverbatim
*>
*> \param[in] NB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realSYcomputational
*
* =====================================================================
SUBROUTINE SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup singleSYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE SSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL SSYTRI_3X
+ EXTERNAL SSYTRI_3X, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup singleSYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup singleSYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> of the matrix B. NRHS >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is REAL array, dimension (LDA,N)
*> Details of factors computed by SSYTRF_AA.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realSYcomputational
*
SUBROUTINE SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL SGTSV, SSWAP, STRSM, XERBLA
+ EXTERNAL SGTSV, SSWAP, SLACPY, STRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief \b SSYTRS_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SSYTRS_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrs_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrs_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrs_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+* IPIV2, B, LDB, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* REAL A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SSYTRS_AA_2STAGE solves a system of linear equations A*X = B with a real
+*> symmetric matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by SSYTRF_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the details of the factorization are stored
+*> as an upper or lower triangular matrix.
+*> = 'U': Upper triangular, form is A = U*T*U**T;
+*> = 'L': Lower triangular, form is A = L*T*L**T.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is REAL array, dimension (LDA,N)
+*> Details of factors computed by SSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is REAL array, dimension (LTB)
+*> Details of factors computed by SSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> SSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] IPIV2
+*> \verbatim
+*> IPIV2 is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> SSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is REAL array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup realSYcomputational
+*
+* =====================================================================
+ SUBROUTINE SSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ REAL A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+* =====================================================================
+*
+ REAL ONE
+ PARAMETER ( ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER LDTB, NB
+ LOGICAL UPPER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL SGBTRS, SLASWP, STRSM, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LTB.LT.( 4*N ) ) THEN
+ INFO = -7
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SSYTRS_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. NRHS.EQ.0 )
+ $ RETURN
+*
+* Read NB and compute LDTB
+*
+ NB = INT( TB( 1 ) )
+ LDTB = LTB/N
+*
+ IF( UPPER ) THEN
+*
+* Solve A*X = B, where A = U*T*U**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL SLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ]
+*
+ CALL STRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (U**T \P**T * B) ]
+*
+ CALL SGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ]
+*
+ CALL STRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ]
+*
+ CALL SLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+*
+ ELSE
+*
+* Solve A*X = B, where A = L*T*L**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL SLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
+*
+ CALL STRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (L \P**T * B) ]
+*
+ CALL SGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
+*
+ CALL STRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
+*
+ CALL SLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of SSYTRS_AA_2STAGE
+*
+ END
*>
*> \param[in,out] B
*> \verbatim
-*> B is REAL array, DIMENSION (LDB,N)
+*> B is REAL array, dimension (LDB,N)
*> Before entry, the leading m by n part of the array B must
*> contain the right-hand side matrix B, and on exit is
*> overwritten by the solution matrix X.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERcomputational
*
SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A,
$ B, LDB )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANSR, DIAG, SIDE, TRANS, UPLO
*>
*> \param[in,out] A
*> \verbatim
-*> A is REAL arrays, dimensions (LDA,N)
+*> A is REAL array, dimension (LDA,N)
*> On entry, the matrix A in the pair (A, B).
*> On exit, the updated matrix A.
*> \endverbatim
*>
*> \param[in,out] B
*> \verbatim
-*> B is REAL arrays, dimensions (LDB,N)
+*> B is REAL array, dimension (LDB,N)
*> On entry, the matrix B in the pair (A, B).
*> On exit, the updated matrix B.
*> \endverbatim
*>
*> \param[in,out] Q
*> \verbatim
-*> Q is REAL array, dimension (LDZ,N)
+*> Q is REAL array, dimension (LDQ,N)
*> On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
*> On exit, the updated matrix Q.
*> Not referenced if WANTQ = .FALSE..
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGEauxiliary
*
SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
$ LDZ, J1, N1, N2, WORK, LWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL WANTQ, WANTZ
*>
*> \param[in,out] Q
*> \verbatim
-*> Q is REAL array, dimension (LDZ,N)
+*> Q is REAL array, dimension (LDQ,N)
*> On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
*> On exit, the updated matrix Q.
*> If WANTQ = .FALSE., Q is not referenced.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realGEcomputational
*
SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
$ LDZ, IFST, ILST, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL WANTQ, WANTZ
*>
*> \param[in,out] A
*> \verbatim
-*> A is REAL array, dimension (LDA,N)
-*> On entry, the lower triangular N-by-N matrix A.
+*> A is REAL array, dimension (LDA,M)
+*> On entry, the lower triangular M-by-M matrix A.
*> On exit, the elements on and below the diagonal of the array
*> contain the lower triangular matrix L.
*> \endverbatim
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[in,out] B
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*> C = [ A ] [ B ]
*>
*>
-*> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*> where A is an lower triangular M-by-M matrix, and B is M-by-N pentagonal
*> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L
*> upper trapezoidal matrix B2:
*> [ B ] = [ B1 ] [ B2 ]
*> [ B1 ] <- M-by-(N-L) rectangular
-*> [ B2 ] <- M-by-L upper trapezoidal.
+*> [ B2 ] <- M-by-L lower trapezoidal.
*>
*> The lower trapezoidal matrix B2 consists of the first L columns of a
-*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
+*> M-by-M lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
*> B is rectangular M-by-N; if M=L=N, B is lower triangular.
*>
*> The matrix W stores the elementary reflectors H(i) in the i-th row
*> above the diagonal (of A) in the M-by-(M+N) input matrix C
*> [ C ] = [ A ] [ B ]
-*> [ A ] <- lower triangular N-by-N
+*> [ A ] <- lower triangular M-by-M
*> [ B ] <- M-by-N pentagonal
*>
*> so that W can be represented as
*> [ W ] = [ I ] [ V ]
-*> [ I ] <- identity, N-by-N
+*> [ I ] <- identity, M-by-M
*> [ V ] <- M-by-N, same form as B.
*>
*> Thus, all of information needed for W is contained on exit in B, which
SUBROUTINE STPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LDT, N, M, L, MB
*>
*> \param[in,out] A
*> \verbatim
-*> A is REAL array, dimension (LDA,N)
+*> A is REAL array, dimension (LDA,M)
*> On entry, the lower triangular M-by-M matrix A.
*> On exit, the elements on and below the diagonal of the array
*> contain the lower triangular matrix L.
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[in,out] B
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*> C = [ A ][ B ]
*>
*>
-*> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*> where A is an lower triangular M-by-M matrix, and B is M-by-N pentagonal
*> matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L
*> upper trapezoidal matrix B2:
*>
*> above the diagonal (of A) in the M-by-(M+N) input matrix C
*>
*> C = [ A ][ B ]
-*> [ A ] <- lower triangular N-by-N
+*> [ A ] <- lower triangular M-by-M
*> [ B ] <- M-by-N pentagonal
*>
*> so that W can be represented as
*>
*> W = [ I ][ V ]
-*> [ I ] <- identity, N-by-N
+*> [ I ] <- identity, M-by-M
*> [ V ] <- M-by-N, same form as B.
*>
*> Thus, all of information needed for W is contained on exit in B, which
* =====================================================================
SUBROUTINE STPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LDT, N, M, L
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleOTHERcomputational
*
SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
$ A, LDA, B, LDB, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, SLARFB
+ EXTERNAL SLARFB, STPRFB, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup realOTHERcomputational
*
SUBROUTINE STPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
$ A, LDA, B, LDB, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL STPRFB, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
* @generated from dtrevc3.f, fortran d -> s, Tue Apr 19 01:47:44 2016
*
$ VR, LDVR, MM, M, WORK, LWORK, INFO )
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
* ..
* .. External Subroutines ..
EXTERNAL SAXPY, SCOPY, SGEMV, SLALN2, SSCAL, XERBLA,
- $ SGEMM, SLABAD, SLASET
+ $ SLACPY, SGEMM, SLABAD, SLASET
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SQRT
*>
*> \param[out] AP
*> \verbatim
-*> AP is REAL array, dimension (N*(N+1)/2
+*> AP is REAL array, dimension (N*(N+1)/2)
*> On exit, the upper or lower triangular matrix A, packed
*> columnwise in a linear array. The j-th column of A is stored
*> in the array AP as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup realOTHERcomputational
*
* =====================================================================
SUBROUTINE STRTTP( UPLO, N, A, LDA, AP, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*>
*> \param[in,out] V2T
*> \verbatim
-*> V2T is COMPLEX*16 array, dimenison (LDV2T,M-Q)
+*> V2T is COMPLEX*16 array, dimension (LDV2T,M-Q)
*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is
*> premultiplied by the conjugate transpose of the right
*> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and
$ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E,
$ B22D, B22E, RWORK, LRWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension (N*NRHS)
+*> WORK is COMPLEX*16 array, dimension (N,NRHS)
*> This array is used to hold the residual vectors.
*> \endverbatim
*>
SUBROUTINE ZCGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK,
$ SWORK, RWORK, ITER, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
* .. External Subroutines ..
EXTERNAL CGETRS, CGETRF, CLAG2Z, XERBLA, ZAXPY, ZGEMM,
- $ ZLACPY, ZLAG2C
+ $ ZLACPY, ZLAG2C, ZGETRF, ZGETRS
* ..
* .. External Functions ..
INTEGER IZAMAX
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension (N*NRHS)
+*> WORK is COMPLEX*16 array, dimension (N,NRHS)
*> This array is used to hold the residual vectors.
*> \endverbatim
*>
SUBROUTINE ZCPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK,
$ SWORK, RWORK, ITER, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
* .. External Subroutines ..
EXTERNAL ZAXPY, ZHEMM, ZLACPY, ZLAT2C, ZLAG2C, CLAG2Z,
- $ CPOTRF, CPOTRS, XERBLA
+ $ CPOTRF, CPOTRS, XERBLA, ZPOTRF, ZPOTRS
* ..
* .. External Functions ..
INTEGER IZAMAX
*>
*> \param[out] ILO
*> \verbatim
+*> ILO is INTEGER
*> \endverbatim
*>
*> \param[out] IHI
*> \verbatim
+*> IHI is INTEGER
*> ILO and IHI are set to INTEGER such that on exit
*> A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
*> If JOB = 'N' or 'S', ILO = 1 and IHI = N.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEcomputational
*
* =====================================================================
SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOB
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is COMPLEX*16 array dimension (min(M,N))
+*> TAUQ is COMPLEX*16 array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the unitary matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEcomputational
*
* =====================================================================
SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is COMPLEX*16 array dimension (min(M,N))
+*> TAUQ is COMPLEX*16 array, dimension (min(M,N))
*> The scalar factors of the elementary reflectors which
*> represent the unitary matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16GEcomputational
*
SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LWORK, M, N
* .. Local Scalars ..
LOGICAL LQUERY
INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
- $ NBMIN, NX
- DOUBLE PRECISION WS
+ $ NBMIN, NX, WS
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZGEBD2, ZGEMM, ZLABRD
-*> \brief \b ZGEJSV\r
-*\r
-* =========== DOCUMENTATION ===========\r
-*\r
-* Online html documentation available at\r
-* http://www.netlib.org/lapack/explore-html/\r
-*\r
-*> \htmlonly\r
-*> Download ZGEJSV + dependencies\r
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgejsv.f">\r
-*> [TGZ]</a>\r
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgejsv.f">\r
-*> [ZIP]</a>\r
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgejsv.f">\r
-*> [TXT]</a>\r
-*> \endhtmlonly\r
-*\r
-* Definition:\r
-* ===========\r
-*\r
-* SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,\r
-* M, N, A, LDA, SVA, U, LDU, V, LDV,\r
-* CWORK, LWORK, RWORK, LRWORK, IWORK, INFO )\r
-*\r
-* .. Scalar Arguments ..\r
-* IMPLICIT NONE\r
-* INTEGER INFO, LDA, LDU, LDV, LWORK, M, N\r
-* ..\r
-* .. Array Arguments ..\r
-* COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK )\r
-* DOUBLE PRECISION SVA( N ), RWORK( LRWORK )\r
-* INTEGER IWORK( * )\r
-* CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV\r
-* ..\r
-*\r
-*\r
-*> \par Purpose:\r
-* =============\r
-*>\r
-*> \verbatim\r
-*>\r
-*> ZGEJSV computes the singular value decomposition (SVD) of a complex M-by-N\r
-*> matrix [A], where M >= N. The SVD of [A] is written as\r
-*>\r
-*> [A] = [U] * [SIGMA] * [V]^*,\r
-*>\r
-*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N\r
-*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and\r
-*> [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are\r
-*> the singular values of [A]. The columns of [U] and [V] are the left and\r
-*> the right singular vectors of [A], respectively. The matrices [U] and [V]\r
-*> are computed and stored in the arrays U and V, respectively. The diagonal\r
-*> of [SIGMA] is computed and stored in the array SVA.\r
-*> \endverbatim\r
-*>\r
-*> Arguments:\r
-*> ==========\r
-*>\r
-*> \param[in] JOBA\r
-*> \verbatim\r
-*> JOBA is CHARACTER*1\r
-*> Specifies the level of accuracy:\r
-*> = 'C': This option works well (high relative accuracy) if A = B * D,\r
-*> with well-conditioned B and arbitrary diagonal matrix D.\r
-*> The accuracy cannot be spoiled by COLUMN scaling. The\r
-*> accuracy of the computed output depends on the condition of\r
-*> B, and the procedure aims at the best theoretical accuracy.\r
-*> The relative error max_{i=1:N}|d sigma_i| / sigma_i is\r
-*> bounded by f(M,N)*epsilon* cond(B), independent of D.\r
-*> The input matrix is preprocessed with the QRF with column\r
-*> pivoting. This initial preprocessing and preconditioning by\r
-*> a rank revealing QR factorization is common for all values of\r
-*> JOBA. Additional actions are specified as follows:\r
-*> = 'E': Computation as with 'C' with an additional estimate of the\r
-*> condition number of B. It provides a realistic error bound.\r
-*> = 'F': If A = D1 * C * D2 with ill-conditioned diagonal scalings\r
-*> D1, D2, and well-conditioned matrix C, this option gives\r
-*> higher accuracy than the 'C' option. If the structure of the\r
-*> input matrix is not known, and relative accuracy is\r
-*> desirable, then this option is advisable. The input matrix A\r
-*> is preprocessed with QR factorization with FULL (row and\r
-*> column) pivoting.\r
-*> = 'G' Computation as with 'F' with an additional estimate of the\r
-*> condition number of B, where A=B*D. If A has heavily weighted\r
-*> rows, then using this condition number gives too pessimistic\r
-*> error bound.\r
-*> = 'A': Small singular values are not well determined by the data \r
-*> and are considered as noisy; the matrix is treated as\r
-*> numerically rank defficient. The error in the computed\r
-*> singular values is bounded by f(m,n)*epsilon*||A||.\r
-*> The computed SVD A = U * S * V^* restores A up to\r
-*> f(m,n)*epsilon*||A||.\r
-*> This gives the procedure the licence to discard (set to zero)\r
-*> all singular values below N*epsilon*||A||.\r
-*> = 'R': Similar as in 'A'. Rank revealing property of the initial\r
-*> QR factorization is used do reveal (using triangular factor)\r
-*> a gap sigma_{r+1} < epsilon * sigma_r in which case the\r
-*> numerical RANK is declared to be r. The SVD is computed with\r
-*> absolute error bounds, but more accurately than with 'A'.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBU\r
-*> \verbatim\r
-*> JOBU is CHARACTER*1\r
-*> Specifies whether to compute the columns of U:\r
-*> = 'U': N columns of U are returned in the array U.\r
-*> = 'F': full set of M left sing. vectors is returned in the array U.\r
-*> = 'W': U may be used as workspace of length M*N. See the description\r
-*> of U.\r
-*> = 'N': U is not computed.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBV\r
-*> \verbatim\r
-*> JOBV is CHARACTER*1\r
-*> Specifies whether to compute the matrix V:\r
-*> = 'V': N columns of V are returned in the array V; Jacobi rotations\r
-*> are not explicitly accumulated.\r
-*> = 'J': N columns of V are returned in the array V, but they are\r
-*> computed as the product of Jacobi rotations, if JOBT .EQ. 'N'.\r
-*> = 'W': V may be used as workspace of length N*N. See the description\r
-*> of V.\r
-*> = 'N': V is not computed.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBR\r
-*> \verbatim\r
-*> JOBR is CHARACTER*1\r
-*> Specifies the RANGE for the singular values. Issues the licence to\r
-*> set to zero small positive singular values if they are outside\r
-*> specified range. If A .NE. 0 is scaled so that the largest singular\r
-*> value of c*A is around SQRT(BIG), BIG=DLAMCH('O'), then JOBR issues\r
-*> the licence to kill columns of A whose norm in c*A is less than\r
-*> SQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN,\r
-*> where SFMIN=DLAMCH('S'), EPSLN=DLAMCH('E').\r
-*> = 'N': Do not kill small columns of c*A. This option assumes that\r
-*> BLAS and QR factorizations and triangular solvers are\r
-*> implemented to work in that range. If the condition of A\r
-*> is greater than BIG, use ZGESVJ.\r
-*> = 'R': RESTRICTED range for sigma(c*A) is [SQRT(SFMIN), SQRT(BIG)]\r
-*> (roughly, as described above). This option is recommended.\r
-*> ===========================\r
-*> For computing the singular values in the FULL range [SFMIN,BIG]\r
-*> use ZGESVJ.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBT\r
-*> \verbatim\r
-*> JOBT is CHARACTER*1\r
-*> If the matrix is square then the procedure may determine to use\r
-*> transposed A if A^* seems to be better with respect to convergence.\r
-*> If the matrix is not square, JOBT is ignored. \r
-*> The decision is based on two values of entropy over the adjoint\r
-*> orbit of A^* * A. See the descriptions of WORK(6) and WORK(7).\r
-*> = 'T': transpose if entropy test indicates possibly faster\r
-*> convergence of Jacobi process if A^* is taken as input. If A is\r
-*> replaced with A^*, then the row pivoting is included automatically.\r
-*> = 'N': do not speculate.\r
-*> The option 'T' can be used to compute only the singular values, or\r
-*> the full SVD (U, SIGMA and V). For only one set of singular vectors\r
-*> (U or V), the caller should provide both U and V, as one of the\r
-*> matrices is used as workspace if the matrix A is transposed.\r
-*> The implementer can easily remove this constraint and make the\r
-*> code more complicated. See the descriptions of U and V.\r
-*> In general, this option is considered experimental, and 'N'; should\r
-*> be preferred. This is subject to changes in the future.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] JOBP\r
-*> \verbatim\r
-*> JOBP is CHARACTER*1\r
-*> Issues the licence to introduce structured perturbations to drown\r
-*> denormalized numbers. This licence should be active if the\r
-*> denormals are poorly implemented, causing slow computation,\r
-*> especially in cases of fast convergence (!). For details see [1,2].\r
-*> For the sake of simplicity, this perturbations are included only\r
-*> when the full SVD or only the singular values are requested. The\r
-*> implementer/user can easily add the perturbation for the cases of\r
-*> computing one set of singular vectors.\r
-*> = 'P': introduce perturbation\r
-*> = 'N': do not perturb\r
-*> \endverbatim\r
-*>\r
-*> \param[in] M\r
-*> \verbatim\r
-*> M is INTEGER\r
-*> The number of rows of the input matrix A. M >= 0.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] N\r
-*> \verbatim\r
-*> N is INTEGER\r
-*> The number of columns of the input matrix A. M >= N >= 0.\r
-*> \endverbatim\r
-*>\r
-*> \param[in,out] A\r
-*> \verbatim\r
-*> A is COMPLEX*16 array, dimension (LDA,N)\r
-*> On entry, the M-by-N matrix A.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LDA\r
-*> \verbatim\r
-*> LDA is INTEGER\r
-*> The leading dimension of the array A. LDA >= max(1,M).\r
-*> \endverbatim\r
-*>\r
-*> \param[out] SVA\r
-*> \verbatim\r
-*> SVA is DOUBLE PRECISION array, dimension (N)\r
-*> On exit,\r
-*> - For WORK(1)/WORK(2) = ONE: The singular values of A. During the\r
-*> computation SVA contains Euclidean column norms of the\r
-*> iterated matrices in the array A.\r
-*> - For WORK(1) .NE. WORK(2): The singular values of A are\r
-*> (WORK(1)/WORK(2)) * SVA(1:N). This factored form is used if\r
-*> sigma_max(A) overflows or if small singular values have been\r
-*> saved from underflow by scaling the input matrix A.\r
-*> - If JOBR='R' then some of the singular values may be returned\r
-*> as exact zeros obtained by "set to zero" because they are\r
-*> below the numerical rank threshold or are denormalized numbers.\r
-*> \endverbatim\r
-*>\r
-*> \param[out] U\r
-*> \verbatim\r
-*> U is COMPLEX*16 array, dimension ( LDU, N )\r
-*> If JOBU = 'U', then U contains on exit the M-by-N matrix of\r
-*> the left singular vectors.\r
-*> If JOBU = 'F', then U contains on exit the M-by-M matrix of\r
-*> the left singular vectors, including an ONB\r
-*> of the orthogonal complement of the Range(A).\r
-*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N),\r
-*> then U is used as workspace if the procedure\r
-*> replaces A with A^*. In that case, [V] is computed\r
-*> in U as left singular vectors of A^* and then\r
-*> copied back to the V array. This 'W' option is just\r
-*> a reminder to the caller that in this case U is\r
-*> reserved as workspace of length N*N.\r
-*> If JOBU = 'N' U is not referenced, unless JOBT='T'.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LDU\r
-*> \verbatim\r
-*> LDU is INTEGER\r
-*> The leading dimension of the array U, LDU >= 1.\r
-*> IF JOBU = 'U' or 'F' or 'W', then LDU >= M.\r
-*> \endverbatim\r
-*>\r
-*> \param[out] V\r
-*> \verbatim\r
-*> V is COMPLEX*16 array, dimension ( LDV, N )\r
-*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of\r
-*> the right singular vectors;\r
-*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N),\r
-*> then V is used as workspace if the pprocedure\r
-*> replaces A with A^*. In that case, [U] is computed\r
-*> in V as right singular vectors of A^* and then\r
-*> copied back to the U array. This 'W' option is just\r
-*> a reminder to the caller that in this case V is\r
-*> reserved as workspace of length N*N.\r
-*> If JOBV = 'N' V is not referenced, unless JOBT='T'.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LDV\r
-*> \verbatim\r
-*> LDV is INTEGER\r
-*> The leading dimension of the array V, LDV >= 1.\r
-*> If JOBV = 'V' or 'J' or 'W', then LDV >= N.\r
-*> \endverbatim\r
-*>\r
-*> \param[out] CWORK\r
-*> \verbatim\r
-*> CWORK is COMPLEX*16 array, dimension (MAX(2,LWORK))\r
-*> If the call to ZGEJSV is a workspace query (indicated by LWORK=-1 or\r
-*> LRWORK=-1), then on exit CWORK(1) contains the required length of\r
-*> CWORK for the job parameters used in the call.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LWORK\r
-*> \verbatim\r
-*> LWORK is INTEGER\r
-*> Length of CWORK to confirm proper allocation of workspace.\r
-*> LWORK depends on the job:\r
-*>\r
-*> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and\r
-*> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'):\r
-*> LWORK >= 2*N+1. This is the minimal requirement.\r
-*> ->> For optimal performance (blocked code) the optimal value\r
-*> is LWORK >= N + (N+1)*NB. Here NB is the optimal\r
-*> block size for ZGEQP3 and ZGEQRF.\r
-*> In general, optimal LWORK is computed as\r
-*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZGEQRF), LWORK(ZGESVJ)).\r
-*> 1.2. .. an estimate of the scaled condition number of A is\r
-*> required (JOBA='E', or 'G'). In this case, LWORK the minimal\r
-*> requirement is LWORK >= N*N + 2*N.\r
-*> ->> For optimal performance (blocked code) the optimal value\r
-*> is LWORK >= max(N+(N+1)*NB, N*N+2*N)=N**2+2*N.\r
-*> In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZGEQRF), LWORK(ZGESVJ),\r
-*> N*N+LWORK(ZPOCON)).\r
-*> 2. If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'),\r
-*> (JOBU.EQ.'N')\r
-*> 2.1 .. no scaled condition estimate requested (JOBE.EQ.'N'): \r
-*> -> the minimal requirement is LWORK >= 3*N.\r
-*> -> For optimal performance, \r
-*> LWORK >= max(N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,\r
-*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQ,\r
-*> ZUNMLQ. In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(ZGEQP3), N+LWORK(ZGESVJ),\r
-*> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMLQ)).\r
-*> 2.2 .. an estimate of the scaled condition number of A is\r
-*> required (JOBA='E', or 'G').\r
-*> -> the minimal requirement is LWORK >= 3*N. \r
-*> -> For optimal performance, \r
-*> LWORK >= max(N+(N+1)*NB, 2*N,2*N+N*NB)=2*N+N*NB,\r
-*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQ,\r
-*> ZUNMLQ. In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(ZGEQP3), LWORK(ZPOCON), N+LWORK(ZGESVJ),\r
-*> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMLQ)). \r
-*> 3. If SIGMA and the left singular vectors are needed\r
-*> 3.1 .. no scaled condition estimate requested (JOBE.EQ.'N'):\r
-*> -> the minimal requirement is LWORK >= 3*N.\r
-*> -> For optimal performance:\r
-*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,\r
-*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZUNMQR.\r
-*> In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(ZGEQP3), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMQR)). \r
-*> 3.2 .. an estimate of the scaled condition number of A is\r
-*> required (JOBA='E', or 'G').\r
-*> -> the minimal requirement is LWORK >= 3*N.\r
-*> -> For optimal performance:\r
-*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,\r
-*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZUNMQR.\r
-*> In general, the optimal length LWORK is computed as\r
-*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZPOCON),\r
-*> 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMQR)).\r
-*> 4. If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and \r
-*> 4.1. if JOBV.EQ.'V' \r
-*> the minimal requirement is LWORK >= 5*N+2*N*N. \r
-*> 4.2. if JOBV.EQ.'J' the minimal requirement is \r
-*> LWORK >= 4*N+N*N.\r
-*> In both cases, the allocated CWORK can accommodate blocked runs\r
-*> of ZGEQP3, ZGEQRF, ZGELQF, SUNMQR, ZUNMLQ.\r
-*>\r
-*> If the call to ZGEJSV is a workspace query (indicated by LWORK=-1 or\r
-*> LRWORK=-1), then on exit CWORK(1) contains the optimal and CWORK(2) contains the\r
-*> minimal length of CWORK for the job parameters used in the call.\r
-*> \endverbatim\r
-*>\r
-*> \param[out] RWORK\r
-*> \verbatim\r
-*> RWORK is DOUBLE PRECISION array, dimension (MAX(7,LWORK))\r
-*> On exit,\r
-*> RWORK(1) = Determines the scaling factor SCALE = RWORK(2) / RWORK(1)\r
-*> such that SCALE*SVA(1:N) are the computed singular values\r
-*> of A. (See the description of SVA().)\r
-*> RWORK(2) = See the description of RWORK(1).\r
-*> RWORK(3) = SCONDA is an estimate for the condition number of\r
-*> column equilibrated A. (If JOBA .EQ. 'E' or 'G')\r
-*> SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1).\r
-*> It is computed using SPOCON. It holds\r
-*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA\r
-*> where R is the triangular factor from the QRF of A.\r
-*> However, if R is truncated and the numerical rank is\r
-*> determined to be strictly smaller than N, SCONDA is\r
-*> returned as -1, thus indicating that the smallest\r
-*> singular values might be lost.\r
-*>\r
-*> If full SVD is needed, the following two condition numbers are\r
-*> useful for the analysis of the algorithm. They are provied for\r
-*> a developer/implementer who is familiar with the details of\r
-*> the method.\r
-*>\r
-*> RWORK(4) = an estimate of the scaled condition number of the\r
-*> triangular factor in the first QR factorization.\r
-*> RWORK(5) = an estimate of the scaled condition number of the\r
-*> triangular factor in the second QR factorization.\r
-*> The following two parameters are computed if JOBT .EQ. 'T'.\r
-*> They are provided for a developer/implementer who is familiar\r
-*> with the details of the method.\r
-*> RWORK(6) = the entropy of A^* * A :: this is the Shannon entropy\r
-*> of diag(A^* * A) / Trace(A^* * A) taken as point in the\r
-*> probability simplex.\r
-*> RWORK(7) = the entropy of A * A^*. (See the description of RWORK(6).)\r
-*> If the call to ZGEJSV is a workspace query (indicated by LWORK=-1 or\r
-*> LRWORK=-1), then on exit RWORK(1) contains the required length of\r
-*> RWORK for the job parameters used in the call.\r
-*> \endverbatim\r
-*>\r
-*> \param[in] LRWORK\r
-*> \verbatim\r
-*> LRWORK is INTEGER\r
-*> Length of RWORK to confirm proper allocation of workspace.\r
-*> LRWORK depends on the job:\r
-*>\r
-*> 1. If only the singular values are requested i.e. if\r
-*> LSAME(JOBU,'N') .AND. LSAME(JOBV,'N')\r
-*> then:\r
-*> 1.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),\r
-*> then: LRWORK = max( 7, 2 * M ).\r
-*> 1.2. Otherwise, LRWORK = max( 7, N ).\r
-*> 2. If singular values with the right singular vectors are requested\r
-*> i.e. if\r
-*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) .AND.\r
-*> .NOT.(LSAME(JOBU,'U').OR.LSAME(JOBU,'F'))\r
-*> then:\r
-*> 2.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),\r
-*> then LRWORK = max( 7, 2 * M ).\r
-*> 2.2. Otherwise, LRWORK = max( 7, N ).\r
-*> 3. If singular values with the left singular vectors are requested, i.e. if\r
-*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND.\r
-*> .NOT.(LSAME(JOBV,'V').OR.LSAME(JOBV,'J'))\r
-*> then:\r
-*> 3.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),\r
-*> then LRWORK = max( 7, 2 * M ).\r
-*> 3.2. Otherwise, LRWORK = max( 7, N ).\r
-*> 4. If singular values with both the left and the right singular vectors\r
-*> are requested, i.e. if\r
-*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND.\r
-*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J'))\r
-*> then:\r
-*> 4.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),\r
-*> then LRWORK = max( 7, 2 * M ).\r
-*> 4.2. Otherwise, LRWORK = max( 7, N ).\r
-*>\r
-*> If, on entry, LRWORK = -1 or LWORK=-1, a workspace query is assumed and \r
-*> the length of RWORK is returned in RWORK(1). \r
-*> \endverbatim\r
-*>\r
-*> \param[out] IWORK\r
-*> \verbatim\r
-*> IWORK is INTEGER array, of dimension at least 4, that further depends \r
-*> on the job:\r
-*>\r
-*> 1. If only the singular values are requested then:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is N+M; otherwise the length of IWORK is N.\r
-*> 2. If the singular values and the right singular vectors are requested then:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is N+M; otherwise the length of IWORK is N. \r
-*> 3. If the singular values and the left singular vectors are requested then:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is N+M; otherwise the length of IWORK is N. \r
-*> 4. If the singular values with both the left and the right singular vectors\r
-*> are requested, then: \r
-*> 4.1. If LSAME(JOBV,'J') the length of IWORK is determined as follows:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is N+M; otherwise the length of IWORK is N. \r
-*> 4.2. If LSAME(JOBV,'V') the length of IWORK is determined as follows:\r
-*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) \r
-*> then the length of IWORK is 2*N+M; otherwise the length of IWORK is 2*N.\r
-*> \r
-*> On exit,\r
-*> IWORK(1) = the numerical rank determined after the initial\r
-*> QR factorization with pivoting. See the descriptions\r
-*> of JOBA and JOBR.\r
-*> IWORK(2) = the number of the computed nonzero singular values\r
-*> IWORK(3) = if nonzero, a warning message:\r
-*> If IWORK(3).EQ.1 then some of the column norms of A\r
-*> were denormalized floats. The requested high accuracy\r
-*> is not warranted by the data.\r
-*> IWORK(4) = 1 or -1. If IWORK(4) .EQ. 1, then the procedure used A^* to\r
-*> do the job as specified by the JOB parameters.\r
-*> If the call to ZGEJSV is a workspace query (indicated by LWORK .EQ. -1 or\r
-*> LRWORK .EQ. -1), then on exit IWORK(1) contains the required length of \r
-*> IWORK for the job parameters used in the call.\r
-*> \endverbatim\r
-*>\r
-*> \param[out] INFO\r
-*> \verbatim\r
-*> INFO is INTEGER\r
-*> < 0 : if INFO = -i, then the i-th argument had an illegal value.\r
-*> = 0 : successful exit;\r
-*> > 0 : ZGEJSV did not converge in the maximal allowed number\r
-*> of sweeps. The computed values may be inaccurate.\r
-*> \endverbatim\r
-*\r
-* Authors:\r
-* ========\r
-*\r
-*> \author Univ. of Tennessee\r
-*> \author Univ. of California Berkeley\r
-*> \author Univ. of Colorado Denver\r
-*> \author NAG Ltd.\r
-*\r
-*> \date June 2016\r
-*\r
-*> \ingroup complex16GEsing\r
-*\r
-*> \par Further Details:\r
-* =====================\r
-*>\r
-*> \verbatim\r
-*>\r
-*> ZGEJSV implements a preconditioned Jacobi SVD algorithm. It uses ZGEQP3,\r
-*> ZGEQRF, and ZGELQF as preprocessors and preconditioners. Optionally, an\r
-*> additional row pivoting can be used as a preprocessor, which in some\r
-*> cases results in much higher accuracy. An example is matrix A with the\r
-*> structure A = D1 * C * D2, where D1, D2 are arbitrarily ill-conditioned\r
-*> diagonal matrices and C is well-conditioned matrix. In that case, complete\r
-*> pivoting in the first QR factorizations provides accuracy dependent on the\r
-*> condition number of C, and independent of D1, D2. Such higher accuracy is\r
-*> not completely understood theoretically, but it works well in practice.\r
-*> Further, if A can be written as A = B*D, with well-conditioned B and some\r
-*> diagonal D, then the high accuracy is guaranteed, both theoretically and\r
-*> in software, independent of D. For more details see [1], [2].\r
-*> The computational range for the singular values can be the full range\r
-*> ( UNDERFLOW,OVERFLOW ), provided that the machine arithmetic and the BLAS\r
-*> & LAPACK routines called by ZGEJSV are implemented to work in that range.\r
-*> If that is not the case, then the restriction for safe computation with\r
-*> the singular values in the range of normalized IEEE numbers is that the\r
-*> spectral condition number kappa(A)=sigma_max(A)/sigma_min(A) does not\r
-*> overflow. This code (ZGEJSV) is best used in this restricted range,\r
-*> meaning that singular values of magnitude below ||A||_2 / DLAMCH('O') are\r
-*> returned as zeros. See JOBR for details on this.\r
-*> Further, this implementation is somewhat slower than the one described\r
-*> in [1,2] due to replacement of some non-LAPACK components, and because\r
-*> the choice of some tuning parameters in the iterative part (ZGESVJ) is\r
-*> left to the implementer on a particular machine.\r
-*> The rank revealing QR factorization (in this code: ZGEQP3) should be\r
-*> implemented as in [3]. We have a new version of ZGEQP3 under development\r
-*> that is more robust than the current one in LAPACK, with a cleaner cut in\r
-*> rank deficient cases. It will be available in the SIGMA library [4].\r
-*> If M is much larger than N, it is obvious that the initial QRF with\r
-*> column pivoting can be preprocessed by the QRF without pivoting. That\r
-*> well known trick is not used in ZGEJSV because in some cases heavy row\r
-*> weighting can be treated with complete pivoting. The overhead in cases\r
-*> M much larger than N is then only due to pivoting, but the benefits in\r
-*> terms of accuracy have prevailed. The implementer/user can incorporate\r
-*> this extra QRF step easily. The implementer can also improve data movement\r
-*> (matrix transpose, matrix copy, matrix transposed copy) - this\r
-*> implementation of ZGEJSV uses only the simplest, naive data movement.\r
-*> \endverbatim\r
-*\r
-*> \par Contributor:\r
-* ==================\r
-*>\r
-*> Zlatko Drmac, Department of Mathematics, Faculty of Science,\r
-*> University of Zagreb (Zagreb, Croatia); drmac@math.hr\r
-*\r
-*> \par References:\r
-* ================\r
-*>\r
-*> \verbatim\r
-*>\r
-*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I.\r
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342.\r
-*> LAPACK Working note 169.\r
-*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II.\r
-*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362.\r
-*> LAPACK Working note 170.\r
-*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR\r
-*> factorization software - a case study.\r
-*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28.\r
-*> LAPACK Working note 176.\r
-*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV,\r
-*> QSVD, (H,K)-SVD computations.\r
-*> Department of Mathematics, University of Zagreb, 2008, 2016.\r
-*> \endverbatim\r
-*\r
-*> \par Bugs, examples and comments:\r
-* =================================\r
-*>\r
-*> Please report all bugs and send interesting examples and/or comments to\r
-*> drmac@math.hr. Thank you.\r
-*>\r
-* =====================================================================\r
- SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,\r
- $ M, N, A, LDA, SVA, U, LDU, V, LDV,\r
- $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO )\r
-*\r
-* -- LAPACK computational routine (version 3.7.0) --\r
-* -- LAPACK is a software package provided by Univ. of Tennessee, --\r
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--\r
-* December 2016\r
-*\r
-* .. Scalar Arguments ..\r
- IMPLICIT NONE\r
- INTEGER INFO, LDA, LDU, LDV, LWORK, LRWORK, M, N\r
-* ..\r
-* .. Array Arguments ..\r
- COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ),\r
- $ CWORK( LWORK )\r
- DOUBLE PRECISION SVA( N ), RWORK( LRWORK )\r
- INTEGER IWORK( * )\r
- CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV\r
-* ..\r
-*\r
-* ===========================================================================\r
-*\r
-* .. Local Parameters ..\r
- DOUBLE PRECISION ZERO, ONE\r
- PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )\r
- COMPLEX*16 CZERO, CONE\r
- PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ), CONE = ( 1.0D0, 0.0D0 ) )\r
-* ..\r
-* .. Local Scalars ..\r
- COMPLEX*16 CTEMP\r
- DOUBLE PRECISION AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1,\r
- $ COND_OK, CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN,\r
- $ MAXPRJ, SCALEM, SCONDA, SFMIN, SMALL, TEMP1,\r
- $ USCAL1, USCAL2, XSC\r
- INTEGER IERR, N1, NR, NUMRANK, p, q, WARNING\r
- LOGICAL ALMORT, DEFR, ERREST, GOSCAL, JRACC, KILL, LQUERY,\r
- $ LSVEC, L2ABER, L2KILL, L2PERT, L2RANK, L2TRAN, NOSCAL,\r
- $ ROWPIV, RSVEC, TRANSP\r
-*\r
- INTEGER OPTWRK, MINWRK, MINRWRK, MINIWRK\r
- INTEGER LWCON, LWLQF, LWQP3, LWQRF, LWUNMLQ, LWUNMQR, LWUNMQRM,\r
- $ LWSVDJ, LWSVDJV, LRWQP3, LRWCON, LRWSVDJ, IWOFF\r
- INTEGER LWRK_ZGELQF, LWRK_ZGEQP3, LWRK_ZGEQP3N, LWRK_ZGEQRF, \r
- $ LWRK_ZGESVJ, LWRK_ZGESVJV, LWRK_ZGESVJU, LWRK_ZUNMLQ, \r
- $ LWRK_ZUNMQR, LWRK_ZUNMQRM \r
-* ..\r
-* .. Local Arrays\r
- COMPLEX*16 CDUMMY(1)\r
- DOUBLE PRECISION RDUMMY(1)\r
-*\r
-* .. Intrinsic Functions ..\r
- INTRINSIC ABS, DCMPLX, CONJG, DLOG, MAX, MIN, DBLE, NINT, SQRT\r
-* ..\r
-* .. External Functions ..\r
- DOUBLE PRECISION DLAMCH, DZNRM2\r
- INTEGER IDAMAX, IZAMAX\r
- LOGICAL LSAME\r
- EXTERNAL IDAMAX, IZAMAX, LSAME, DLAMCH, DZNRM2\r
-* ..\r
-* .. External Subroutines ..\r
- EXTERNAL DLASSQ, ZCOPY, ZGELQF, ZGEQP3, ZGEQRF, ZLACPY, ZLAPMR,\r
- $ ZLASCL, DLASCL, ZLASET, ZLASSQ, ZLASWP, ZUNGQR, ZUNMLQ,\r
- $ ZUNMQR, ZPOCON, DSCAL, ZDSCAL, ZSWAP, ZTRSM, ZLACGV,\r
- $ XERBLA\r
-*\r
- EXTERNAL ZGESVJ\r
-* ..\r
-*\r
-* Test the input arguments\r
-*\r
- LSVEC = LSAME( JOBU, 'U' ) .OR. LSAME( JOBU, 'F' )\r
- JRACC = LSAME( JOBV, 'J' )\r
- RSVEC = LSAME( JOBV, 'V' ) .OR. JRACC\r
- ROWPIV = LSAME( JOBA, 'F' ) .OR. LSAME( JOBA, 'G' )\r
- L2RANK = LSAME( JOBA, 'R' )\r
- L2ABER = LSAME( JOBA, 'A' )\r
- ERREST = LSAME( JOBA, 'E' ) .OR. LSAME( JOBA, 'G' )\r
- L2TRAN = LSAME( JOBT, 'T' ) .AND. ( M .EQ. N )\r
- L2KILL = LSAME( JOBR, 'R' )\r
- DEFR = LSAME( JOBR, 'N' )\r
- L2PERT = LSAME( JOBP, 'P' )\r
-*\r
- LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 )\r
-*\r
- IF ( .NOT.(ROWPIV .OR. L2RANK .OR. L2ABER .OR.\r
- $ ERREST .OR. LSAME( JOBA, 'C' ) )) THEN\r
- INFO = - 1\r
- ELSE IF ( .NOT.( LSVEC .OR. LSAME( JOBU, 'N' ) .OR.\r
- $ ( LSAME( JOBU, 'W' ) .AND. RSVEC .AND. L2TRAN ) ) ) THEN\r
- INFO = - 2\r
- ELSE IF ( .NOT.( RSVEC .OR. LSAME( JOBV, 'N' ) .OR.\r
- $ ( LSAME( JOBV, 'W' ) .AND. LSVEC .AND. L2TRAN ) ) ) THEN\r
- INFO = - 3\r
- ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN\r
- INFO = - 4\r
- ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. LSAME(JOBT,'N') ) ) THEN\r
- INFO = - 5\r
- ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN\r
- INFO = - 6\r
- ELSE IF ( M .LT. 0 ) THEN\r
- INFO = - 7\r
- ELSE IF ( ( N .LT. 0 ) .OR. ( N .GT. M ) ) THEN\r
- INFO = - 8\r
- ELSE IF ( LDA .LT. M ) THEN\r
- INFO = - 10\r
- ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN\r
- INFO = - 13\r
- ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN\r
- INFO = - 15\r
- ELSE\r
-* #:)\r
- INFO = 0\r
- END IF\r
-*\r
- IF ( INFO .EQ. 0 ) THEN \r
-* .. compute the minimal and the optimal workspace lengths \r
-* [[The expressions for computing the minimal and the optimal\r
-* values of LCWORK, LRWORK are written with a lot of redundancy and\r
-* can be simplified. However, this verbose form is useful for\r
-* maintenance and modifications of the code.]]\r
-*\r
-* .. minimal workspace length for ZGEQP3 of an M x N matrix,\r
-* ZGEQRF of an N x N matrix, ZGELQF of an N x N matrix,\r
-* ZUNMLQ for computing N x N matrix, ZUNMQR for computing N x N\r
-* matrix, ZUNMQR for computing M x N matrix, respectively.\r
- LWQP3 = N+1 \r
- LWQRF = MAX( 1, N )\r
- LWLQF = MAX( 1, N )\r
- LWUNMLQ = MAX( 1, N )\r
- LWUNMQR = MAX( 1, N )\r
- LWUNMQRM = MAX( 1, M )\r
-* .. minimal workspace length for ZPOCON of an N x N matrix\r
- LWCON = 2 * N \r
-* .. minimal workspace length for ZGESVJ of an N x N matrix,\r
-* without and with explicit accumulation of Jacobi rotations\r
- LWSVDJ = MAX( 2 * N, 1 ) \r
- LWSVDJV = MAX( 2 * N, 1 )\r
-* .. minimal REAL workspace length for ZGEQP3, ZPOCON, ZGESVJ\r
- LRWQP3 = N \r
- LRWCON = N \r
- LRWSVDJ = N \r
- IF ( LQUERY ) THEN \r
- CALL ZGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, \r
- $ RDUMMY, IERR )\r
- LWRK_ZGEQP3 = CDUMMY(1)\r
- CALL ZGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )\r
- LWRK_ZGEQRF = CDUMMY(1)\r
- CALL ZGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )\r
- LWRK_ZGELQF = CDUMMY(1) \r
- END IF\r
- MINWRK = 2\r
- OPTWRK = 2\r
- MINIWRK = N \r
- IF ( .NOT. (LSVEC .OR. RSVEC ) ) THEN\r
-* .. minimal and optimal sizes of the complex workspace if\r
-* only the singular values are requested\r
- IF ( ERREST ) THEN \r
- MINWRK = MAX( N+LWQP3, N**2+LWCON, N+LWQRF, LWSVDJ )\r
- ELSE\r
- MINWRK = MAX( N+LWQP3, N+LWQRF, LWSVDJ )\r
- END IF\r
- IF ( LQUERY ) THEN \r
- CALL ZGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, \r
- $ LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_ZGESVJ = CDUMMY(1)\r
- IF ( ERREST ) THEN \r
- OPTWRK = MAX( N+LWRK_ZGEQP3, N**2+LWCON, \r
- $ N+LWRK_ZGEQRF, LWRK_ZGESVJ )\r
- ELSE\r
- OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWRK_ZGEQRF, \r
- $ LWRK_ZGESVJ )\r
- END IF\r
- END IF\r
- IF ( L2TRAN .OR. ROWPIV ) THEN \r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWCON, LRWSVDJ )\r
- ELSE\r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )\r
- END IF \r
- ELSE\r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, LRWQP3, LRWCON, LRWSVDJ )\r
- ELSE\r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )\r
- END IF\r
- END IF \r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M \r
- ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN\r
-* .. minimal and optimal sizes of the complex workspace if the\r
-* singular values and the right singular vectors are requested\r
- IF ( ERREST ) THEN \r
- MINWRK = MAX( N+LWQP3, LWCON, LWSVDJ, N+LWLQF, \r
- $ 2*N+LWQRF, N+LWSVDJ, N+LWUNMLQ )\r
- ELSE\r
- MINWRK = MAX( N+LWQP3, LWSVDJ, N+LWLQF, 2*N+LWQRF, \r
- $ N+LWSVDJ, N+LWUNMLQ )\r
- END IF\r
- IF ( LQUERY ) THEN\r
- CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,\r
- $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_ZGESVJ = CDUMMY(1)\r
- CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,\r
- $ V, LDV, CDUMMY, -1, IERR )\r
- LWRK_ZUNMLQ = CDUMMY(1) \r
- IF ( ERREST ) THEN \r
- OPTWRK = MAX( N+LWRK_ZGEQP3, LWCON, LWRK_ZGESVJ, \r
- $ N+LWRK_ZGELQF, 2*N+LWRK_ZGEQRF,\r
- $ N+LWRK_ZGESVJ, N+LWRK_ZUNMLQ )\r
- ELSE\r
- OPTWRK = MAX( N+LWRK_ZGEQP3, LWRK_ZGESVJ,N+LWRK_ZGELQF,\r
- $ 2*N+LWRK_ZGEQRF, N+LWRK_ZGESVJ, \r
- $ N+LWRK_ZUNMLQ )\r
- END IF\r
- END IF\r
- IF ( L2TRAN .OR. ROWPIV ) THEN \r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ ) \r
- END IF \r
- ELSE\r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ ) \r
- END IF \r
- END IF\r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M\r
- ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN \r
-* .. minimal and optimal sizes of the complex workspace if the\r
-* singular values and the left singular vectors are requested\r
- IF ( ERREST ) THEN\r
- MINWRK = N + MAX( LWQP3,LWCON,N+LWQRF,LWSVDJ,LWUNMQRM )\r
- ELSE\r
- MINWRK = N + MAX( LWQP3, N+LWQRF, LWSVDJ, LWUNMQRM )\r
- END IF\r
- IF ( LQUERY ) THEN\r
- CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,\r
- $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_ZGESVJ = CDUMMY(1)\r
- CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,\r
- $ LDU, CDUMMY, -1, IERR )\r
- LWRK_ZUNMQRM = CDUMMY(1)\r
- IF ( ERREST ) THEN\r
- OPTWRK = N + MAX( LWRK_ZGEQP3, LWCON, N+LWRK_ZGEQRF,\r
- $ LWRK_ZGESVJ, LWRK_ZUNMQRM )\r
- ELSE\r
- OPTWRK = N + MAX( LWRK_ZGEQP3, N+LWRK_ZGEQRF,\r
- $ LWRK_ZGESVJ, LWRK_ZUNMQRM )\r
- END IF\r
- END IF\r
- IF ( L2TRAN .OR. ROWPIV ) THEN \r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )\r
- END IF \r
- ELSE\r
- IF ( ERREST ) THEN \r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )\r
- END IF \r
- END IF \r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M\r
- ELSE\r
-* .. minimal and optimal sizes of the complex workspace if the\r
-* full SVD is requested\r
- IF ( .NOT. JRACC ) THEN \r
- IF ( ERREST ) THEN \r
- MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+N**2+LWCON, \r
- $ 2*N+LWQRF, 2*N+LWQP3, \r
- $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON,\r
- $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV, \r
- $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ, \r
- $ N+N**2+LWSVDJ, N+LWUNMQRM )\r
- ELSE\r
- MINWRK = MAX( N+LWQP3, 2*N+N**2+LWCON, \r
- $ 2*N+LWQRF, 2*N+LWQP3, \r
- $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON,\r
- $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV,\r
- $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ,\r
- $ N+N**2+LWSVDJ, N+LWUNMQRM ) \r
- END IF \r
- MINIWRK = MINIWRK + N \r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M\r
- ELSE\r
- IF ( ERREST ) THEN \r
- MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+LWQRF, \r
- $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR, \r
- $ N+LWUNMQRM )\r
- ELSE\r
- MINWRK = MAX( N+LWQP3, 2*N+LWQRF, \r
- $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR, \r
- $ N+LWUNMQRM ) \r
- END IF \r
- IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M\r
- END IF\r
- IF ( LQUERY ) THEN\r
- CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,\r
- $ LDU, CDUMMY, -1, IERR )\r
- LWRK_ZUNMQRM = CDUMMY(1)\r
- CALL ZUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U,\r
- $ LDU, CDUMMY, -1, IERR )\r
- LWRK_ZUNMQR = CDUMMY(1)\r
- IF ( .NOT. JRACC ) THEN\r
- CALL ZGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1,\r
- $ RDUMMY, IERR )\r
- LWRK_ZGEQP3N = CDUMMY(1)\r
- CALL ZGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA,\r
- $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_ZGESVJ = CDUMMY(1)\r
- CALL ZGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA,\r
- $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_ZGESVJU = CDUMMY(1)\r
- CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,\r
- $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_ZGESVJV = CDUMMY(1)\r
- CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,\r
- $ V, LDV, CDUMMY, -1, IERR )\r
- LWRK_ZUNMLQ = CDUMMY(1)\r
- IF ( ERREST ) THEN \r
- OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, \r
- $ 2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF, \r
- $ 2*N+LWRK_ZGEQP3N, \r
- $ 2*N+N**2+N+LWRK_ZGELQF, \r
- $ 2*N+N**2+N+N**2+LWCON,\r
- $ 2*N+N**2+N+LWRK_ZGESVJ, \r
- $ 2*N+N**2+N+LWRK_ZGESVJV, \r
- $ 2*N+N**2+N+LWRK_ZUNMQR,\r
- $ 2*N+N**2+N+LWRK_ZUNMLQ, \r
- $ N+N**2+LWRK_ZGESVJU, \r
- $ N+LWRK_ZUNMQRM )\r
- ELSE\r
- OPTWRK = MAX( N+LWRK_ZGEQP3, \r
- $ 2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF, \r
- $ 2*N+LWRK_ZGEQP3N, \r
- $ 2*N+N**2+N+LWRK_ZGELQF, \r
- $ 2*N+N**2+N+N**2+LWCON,\r
- $ 2*N+N**2+N+LWRK_ZGESVJ, \r
- $ 2*N+N**2+N+LWRK_ZGESVJV, \r
- $ 2*N+N**2+N+LWRK_ZUNMQR,\r
- $ 2*N+N**2+N+LWRK_ZUNMLQ, \r
- $ N+N**2+LWRK_ZGESVJU,\r
- $ N+LWRK_ZUNMQRM )\r
- END IF \r
- ELSE\r
- CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,\r
- $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )\r
- LWRK_ZGESVJV = CDUMMY(1)\r
- CALL ZUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY,\r
- $ V, LDV, CDUMMY, -1, IERR )\r
- LWRK_ZUNMQR = CDUMMY(1)\r
- CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,\r
- $ LDU, CDUMMY, -1, IERR )\r
- LWRK_ZUNMQRM = CDUMMY(1) \r
- IF ( ERREST ) THEN \r
- OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, \r
- $ 2*N+LWRK_ZGEQRF, 2*N+N**2, \r
- $ 2*N+N**2+LWRK_ZGESVJV, \r
- $ 2*N+N**2+N+LWRK_ZUNMQR,N+LWRK_ZUNMQRM )\r
- ELSE\r
- OPTWRK = MAX( N+LWRK_ZGEQP3, 2*N+LWRK_ZGEQRF, \r
- $ 2*N+N**2, 2*N+N**2+LWRK_ZGESVJV, \r
- $ 2*N+N**2+N+LWRK_ZUNMQR, \r
- $ N+LWRK_ZUNMQRM ) \r
- END IF \r
- END IF \r
- END IF \r
- IF ( L2TRAN .OR. ROWPIV ) THEN \r
- MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )\r
- ELSE\r
- MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )\r
- END IF \r
- END IF\r
- MINWRK = MAX( 2, MINWRK )\r
- OPTWRK = MAX( 2, OPTWRK )\r
- IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = - 17\r
- IF ( LRWORK .LT. MINRWRK .AND. (.NOT.LQUERY) ) INFO = - 19 \r
- END IF\r
-* \r
- IF ( INFO .NE. 0 ) THEN\r
-* #:(\r
- CALL XERBLA( 'ZGEJSV', - INFO )\r
- RETURN\r
- ELSE IF ( LQUERY ) THEN\r
- CWORK(1) = OPTWRK\r
- CWORK(2) = MINWRK\r
- RWORK(1) = MINRWRK\r
- IWORK(1) = MAX( 4, MINIWRK )\r
- RETURN \r
- END IF\r
-*\r
-* Quick return for void matrix (Y3K safe)\r
-* #:)\r
- IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN\r
- IWORK(1:4) = 0\r
- RWORK(1:7) = 0\r
- RETURN\r
- ENDIF\r
-*\r
-* Determine whether the matrix U should be M x N or M x M\r
-*\r
- IF ( LSVEC ) THEN\r
- N1 = N\r
- IF ( LSAME( JOBU, 'F' ) ) N1 = M\r
- END IF\r
-*\r
-* Set numerical parameters\r
-*\r
-*! NOTE: Make sure DLAMCH() does not fail on the target architecture.\r
-*\r
- EPSLN = DLAMCH('Epsilon')\r
- SFMIN = DLAMCH('SafeMinimum')\r
- SMALL = SFMIN / EPSLN\r
- BIG = DLAMCH('O')\r
-* BIG = ONE / SFMIN\r
-*\r
-* Initialize SVA(1:N) = diag( ||A e_i||_2 )_1^N\r
-*\r
-*(!) If necessary, scale SVA() to protect the largest norm from\r
-* overflow. It is possible that this scaling pushes the smallest\r
-* column norm left from the underflow threshold (extreme case).\r
-*\r
- SCALEM = ONE / SQRT(DBLE(M)*DBLE(N))\r
- NOSCAL = .TRUE.\r
- GOSCAL = .TRUE.\r
- DO 1874 p = 1, N\r
- AAPP = ZERO\r
- AAQQ = ONE\r
- CALL ZLASSQ( M, A(1,p), 1, AAPP, AAQQ )\r
- IF ( AAPP .GT. BIG ) THEN\r
- INFO = - 9\r
- CALL XERBLA( 'ZGEJSV', -INFO )\r
- RETURN\r
- END IF\r
- AAQQ = SQRT(AAQQ)\r
- IF ( ( AAPP .LT. (BIG / AAQQ) ) .AND. NOSCAL ) THEN\r
- SVA(p) = AAPP * AAQQ\r
- ELSE\r
- NOSCAL = .FALSE.\r
- SVA(p) = AAPP * ( AAQQ * SCALEM )\r
- IF ( GOSCAL ) THEN\r
- GOSCAL = .FALSE.\r
- CALL DSCAL( p-1, SCALEM, SVA, 1 )\r
- END IF\r
- END IF\r
- 1874 CONTINUE\r
-*\r
- IF ( NOSCAL ) SCALEM = ONE\r
-*\r
- AAPP = ZERO\r
- AAQQ = BIG\r
- DO 4781 p = 1, N\r
- AAPP = MAX( AAPP, SVA(p) )\r
- IF ( SVA(p) .NE. ZERO ) AAQQ = MIN( AAQQ, SVA(p) )\r
- 4781 CONTINUE\r
-*\r
-* Quick return for zero M x N matrix\r
-* #:)\r
- IF ( AAPP .EQ. ZERO ) THEN\r
- IF ( LSVEC ) CALL ZLASET( 'G', M, N1, CZERO, CONE, U, LDU )\r
- IF ( RSVEC ) CALL ZLASET( 'G', N, N, CZERO, CONE, V, LDV )\r
- RWORK(1) = ONE\r
- RWORK(2) = ONE\r
- IF ( ERREST ) RWORK(3) = ONE\r
- IF ( LSVEC .AND. RSVEC ) THEN\r
- RWORK(4) = ONE\r
- RWORK(5) = ONE\r
- END IF\r
- IF ( L2TRAN ) THEN\r
- RWORK(6) = ZERO\r
- RWORK(7) = ZERO\r
- END IF\r
- IWORK(1) = 0\r
- IWORK(2) = 0\r
- IWORK(3) = 0\r
- IWORK(4) = -1\r
- RETURN\r
- END IF\r
-*\r
-* Issue warning if denormalized column norms detected. Override the\r
-* high relative accuracy request. Issue licence to kill nonzero columns\r
-* (set them to zero) whose norm is less than sigma_max / BIG (roughly).\r
-* #:(\r
- WARNING = 0\r
- IF ( AAQQ .LE. SFMIN ) THEN\r
- L2RANK = .TRUE.\r
- L2KILL = .TRUE.\r
- WARNING = 1\r
- END IF\r
-*\r
-* Quick return for one-column matrix\r
-* #:)\r
- IF ( N .EQ. 1 ) THEN\r
-*\r
- IF ( LSVEC ) THEN\r
- CALL ZLASCL( 'G',0,0,SVA(1),SCALEM, M,1,A(1,1),LDA,IERR )\r
- CALL ZLACPY( 'A', M, 1, A, LDA, U, LDU )\r
-* computing all M left singular vectors of the M x 1 matrix\r
- IF ( N1 .NE. N ) THEN\r
- CALL ZGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N,IERR )\r
- CALL ZUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N,IERR )\r
- CALL ZCOPY( M, A(1,1), 1, U(1,1), 1 )\r
- END IF\r
- END IF\r
- IF ( RSVEC ) THEN\r
- V(1,1) = CONE\r
- END IF\r
- IF ( SVA(1) .LT. (BIG*SCALEM) ) THEN\r
- SVA(1) = SVA(1) / SCALEM\r
- SCALEM = ONE\r
- END IF\r
- RWORK(1) = ONE / SCALEM\r
- RWORK(2) = ONE\r
- IF ( SVA(1) .NE. ZERO ) THEN\r
- IWORK(1) = 1\r
- IF ( ( SVA(1) / SCALEM) .GE. SFMIN ) THEN\r
- IWORK(2) = 1\r
- ELSE\r
- IWORK(2) = 0\r
- END IF\r
- ELSE\r
- IWORK(1) = 0\r
- IWORK(2) = 0\r
- END IF\r
- IWORK(3) = 0\r
- IWORK(4) = -1\r
- IF ( ERREST ) RWORK(3) = ONE\r
- IF ( LSVEC .AND. RSVEC ) THEN\r
- RWORK(4) = ONE\r
- RWORK(5) = ONE\r
- END IF\r
- IF ( L2TRAN ) THEN\r
- RWORK(6) = ZERO\r
- RWORK(7) = ZERO\r
- END IF\r
- RETURN\r
-*\r
- END IF\r
-*\r
- TRANSP = .FALSE.\r
-*\r
- AATMAX = -ONE\r
- AATMIN = BIG\r
- IF ( ROWPIV .OR. L2TRAN ) THEN\r
-*\r
-* Compute the row norms, needed to determine row pivoting sequence\r
-* (in the case of heavily row weighted A, row pivoting is strongly\r
-* advised) and to collect information needed to compare the\r
-* structures of A * A^* and A^* * A (in the case L2TRAN.EQ..TRUE.).\r
-*\r
- IF ( L2TRAN ) THEN\r
- DO 1950 p = 1, M\r
- XSC = ZERO\r
- TEMP1 = ONE\r
- CALL ZLASSQ( N, A(p,1), LDA, XSC, TEMP1 )\r
-* ZLASSQ gets both the ell_2 and the ell_infinity norm\r
-* in one pass through the vector\r
- RWORK(M+p) = XSC * SCALEM\r
- RWORK(p) = XSC * (SCALEM*SQRT(TEMP1))\r
- AATMAX = MAX( AATMAX, RWORK(p) )\r
- IF (RWORK(p) .NE. ZERO) \r
- $ AATMIN = MIN(AATMIN,RWORK(p))\r
- 1950 CONTINUE\r
- ELSE\r
- DO 1904 p = 1, M\r
- RWORK(M+p) = SCALEM*ABS( A(p,IZAMAX(N,A(p,1),LDA)) )\r
- AATMAX = MAX( AATMAX, RWORK(M+p) )\r
- AATMIN = MIN( AATMIN, RWORK(M+p) )\r
- 1904 CONTINUE\r
- END IF\r
-*\r
- END IF\r
-*\r
-* For square matrix A try to determine whether A^* would be better\r
-* input for the preconditioned Jacobi SVD, with faster convergence.\r
-* The decision is based on an O(N) function of the vector of column\r
-* and row norms of A, based on the Shannon entropy. This should give\r
-* the right choice in most cases when the difference actually matters.\r
-* It may fail and pick the slower converging side.\r
-*\r
- ENTRA = ZERO\r
- ENTRAT = ZERO\r
- IF ( L2TRAN ) THEN\r
-*\r
- XSC = ZERO\r
- TEMP1 = ONE\r
- CALL DLASSQ( N, SVA, 1, XSC, TEMP1 )\r
- TEMP1 = ONE / TEMP1\r
-*\r
- ENTRA = ZERO\r
- DO 1113 p = 1, N\r
- BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1\r
- IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * DLOG(BIG1)\r
- 1113 CONTINUE\r
- ENTRA = - ENTRA / DLOG(DBLE(N))\r
-*\r
-* Now, SVA().^2/Trace(A^* * A) is a point in the probability simplex.\r
-* It is derived from the diagonal of A^* * A. Do the same with the\r
-* diagonal of A * A^*, compute the entropy of the corresponding\r
-* probability distribution. Note that A * A^* and A^* * A have the\r
-* same trace.\r
-*\r
- ENTRAT = ZERO\r
- DO 1114 p = 1, M\r
- BIG1 = ( ( RWORK(p) / XSC )**2 ) * TEMP1\r
- IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * DLOG(BIG1)\r
- 1114 CONTINUE\r
- ENTRAT = - ENTRAT / DLOG(DBLE(M))\r
-*\r
-* Analyze the entropies and decide A or A^*. Smaller entropy\r
-* usually means better input for the algorithm.\r
-*\r
- TRANSP = ( ENTRAT .LT. ENTRA )\r
-* \r
-* If A^* is better than A, take the adjoint of A. This is allowed\r
-* only for square matrices, M=N.\r
- IF ( TRANSP ) THEN\r
-* In an optimal implementation, this trivial transpose\r
-* should be replaced with faster transpose.\r
- DO 1115 p = 1, N - 1\r
- A(p,p) = CONJG(A(p,p))\r
- DO 1116 q = p + 1, N\r
- CTEMP = CONJG(A(q,p))\r
- A(q,p) = CONJG(A(p,q))\r
- A(p,q) = CTEMP\r
- 1116 CONTINUE\r
- 1115 CONTINUE\r
- A(N,N) = CONJG(A(N,N))\r
- DO 1117 p = 1, N\r
- RWORK(M+p) = SVA(p)\r
- SVA(p) = RWORK(p)\r
-* previously computed row 2-norms are now column 2-norms\r
-* of the transposed matrix\r
- 1117 CONTINUE\r
- TEMP1 = AAPP\r
- AAPP = AATMAX\r
- AATMAX = TEMP1\r
- TEMP1 = AAQQ\r
- AAQQ = AATMIN\r
- AATMIN = TEMP1\r
- KILL = LSVEC\r
- LSVEC = RSVEC\r
- RSVEC = KILL\r
- IF ( LSVEC ) N1 = N\r
-*\r
- ROWPIV = .TRUE.\r
- END IF\r
-*\r
- END IF\r
-* END IF L2TRAN\r
-*\r
-* Scale the matrix so that its maximal singular value remains less\r
-* than SQRT(BIG) -- the matrix is scaled so that its maximal column\r
-* has Euclidean norm equal to SQRT(BIG/N). The only reason to keep\r
-* SQRT(BIG) instead of BIG is the fact that ZGEJSV uses LAPACK and\r
-* BLAS routines that, in some implementations, are not capable of\r
-* working in the full interval [SFMIN,BIG] and that they may provoke\r
-* overflows in the intermediate results. If the singular values spread\r
-* from SFMIN to BIG, then ZGESVJ will compute them. So, in that case,\r
-* one should use ZGESVJ instead of ZGEJSV.\r
-* >> change in the April 2016 update: allow bigger range, i.e. the\r
-* largest column is allowed up to BIG/N and ZGESVJ will do the rest.\r
- BIG1 = SQRT( BIG )\r
- TEMP1 = SQRT( BIG / DBLE(N) ) \r
-* TEMP1 = BIG/DBLE(N)\r
-*\r
- CALL DLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR )\r
- IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN\r
- AAQQ = ( AAQQ / AAPP ) * TEMP1\r
- ELSE\r
- AAQQ = ( AAQQ * TEMP1 ) / AAPP\r
- END IF\r
- TEMP1 = TEMP1 * SCALEM\r
- CALL ZLASCL( 'G', 0, 0, AAPP, TEMP1, M, N, A, LDA, IERR )\r
-*\r
-* To undo scaling at the end of this procedure, multiply the\r
-* computed singular values with USCAL2 / USCAL1.\r
-*\r
- USCAL1 = TEMP1\r
- USCAL2 = AAPP\r
-*\r
- IF ( L2KILL ) THEN\r
-* L2KILL enforces computation of nonzero singular values in\r
-* the restricted range of condition number of the initial A,\r
-* sigma_max(A) / sigma_min(A) approx. SQRT(BIG)/SQRT(SFMIN).\r
- XSC = SQRT( SFMIN )\r
- ELSE\r
- XSC = SMALL\r
-*\r
-* Now, if the condition number of A is too big,\r
-* sigma_max(A) / sigma_min(A) .GT. SQRT(BIG/N) * EPSLN / SFMIN,\r
-* as a precaution measure, the full SVD is computed using ZGESVJ\r
-* with accumulated Jacobi rotations. This provides numerically\r
-* more robust computation, at the cost of slightly increased run\r
-* time. Depending on the concrete implementation of BLAS and LAPACK\r
-* (i.e. how they behave in presence of extreme ill-conditioning) the\r
-* implementor may decide to remove this switch.\r
- IF ( ( AAQQ.LT.SQRT(SFMIN) ) .AND. LSVEC .AND. RSVEC ) THEN\r
- JRACC = .TRUE.\r
- END IF\r
-*\r
- END IF\r
- IF ( AAQQ .LT. XSC ) THEN\r
- DO 700 p = 1, N\r
- IF ( SVA(p) .LT. XSC ) THEN\r
- CALL ZLASET( 'A', M, 1, CZERO, CZERO, A(1,p), LDA )\r
- SVA(p) = ZERO\r
- END IF\r
- 700 CONTINUE\r
- END IF\r
-*\r
-* Preconditioning using QR factorization with pivoting\r
-*\r
- IF ( ROWPIV ) THEN\r
-* Optional row permutation (Bjoerck row pivoting):\r
-* A result by Cox and Higham shows that the Bjoerck's\r
-* row pivoting combined with standard column pivoting\r
-* has similar effect as Powell-Reid complete pivoting.\r
-* The ell-infinity norms of A are made nonincreasing.\r
- IF ( ( LSVEC .AND. RSVEC ) .AND. .NOT.( JRACC ) ) THEN \r
- IWOFF = 2*N\r
- ELSE\r
- IWOFF = N\r
- END IF\r
- DO 1952 p = 1, M - 1\r
- q = IDAMAX( M-p+1, RWORK(M+p), 1 ) + p - 1\r
- IWORK(IWOFF+p) = q\r
- IF ( p .NE. q ) THEN\r
- TEMP1 = RWORK(M+p)\r
- RWORK(M+p) = RWORK(M+q)\r
- RWORK(M+q) = TEMP1\r
- END IF\r
- 1952 CONTINUE\r
- CALL ZLASWP( N, A, LDA, 1, M-1, IWORK(IWOFF+1), 1 )\r
- END IF\r
-*\r
-* End of the preparation phase (scaling, optional sorting and\r
-* transposing, optional flushing of small columns).\r
-*\r
-* Preconditioning\r
-*\r
-* If the full SVD is needed, the right singular vectors are computed\r
-* from a matrix equation, and for that we need theoretical analysis\r
-* of the Businger-Golub pivoting. So we use ZGEQP3 as the first RR QRF.\r
-* In all other cases the first RR QRF can be chosen by other criteria\r
-* (eg speed by replacing global with restricted window pivoting, such\r
-* as in xGEQPX from TOMS # 782). Good results will be obtained using\r
-* xGEQPX with properly (!) chosen numerical parameters.\r
-* Any improvement of ZGEQP3 improves overal performance of ZGEJSV.\r
-*\r
-* A * P1 = Q1 * [ R1^* 0]^*:\r
- DO 1963 p = 1, N\r
-* .. all columns are free columns\r
- IWORK(p) = 0\r
- 1963 CONTINUE\r
- CALL ZGEQP3( M, N, A, LDA, IWORK, CWORK, CWORK(N+1), LWORK-N,\r
- $ RWORK, IERR )\r
-*\r
-* The upper triangular matrix R1 from the first QRF is inspected for\r
-* rank deficiency and possibilities for deflation, or possible\r
-* ill-conditioning. Depending on the user specified flag L2RANK,\r
-* the procedure explores possibilities to reduce the numerical\r
-* rank by inspecting the computed upper triangular factor. If\r
-* L2RANK or L2ABER are up, then ZGEJSV will compute the SVD of\r
-* A + dA, where ||dA|| <= f(M,N)*EPSLN.\r
-*\r
- NR = 1\r
- IF ( L2ABER ) THEN\r
-* Standard absolute error bound suffices. All sigma_i with\r
-* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an\r
-* agressive enforcement of lower numerical rank by introducing a\r
-* backward error of the order of N*EPSLN*||A||.\r
- TEMP1 = SQRT(DBLE(N))*EPSLN\r
- DO 3001 p = 2, N\r
- IF ( ABS(A(p,p)) .GE. (TEMP1*ABS(A(1,1))) ) THEN\r
- NR = NR + 1\r
- ELSE\r
- GO TO 3002\r
- END IF\r
- 3001 CONTINUE\r
- 3002 CONTINUE\r
- ELSE IF ( L2RANK ) THEN\r
-* .. similarly as above, only slightly more gentle (less agressive).\r
-* Sudden drop on the diagonal of R1 is used as the criterion for\r
-* close-to-rank-deficient.\r
- TEMP1 = SQRT(SFMIN)\r
- DO 3401 p = 2, N\r
- IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR.\r
- $ ( ABS(A(p,p)) .LT. SMALL ) .OR.\r
- $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3402\r
- NR = NR + 1\r
- 3401 CONTINUE\r
- 3402 CONTINUE\r
-*\r
- ELSE\r
-* The goal is high relative accuracy. However, if the matrix\r
-* has high scaled condition number the relative accuracy is in\r
-* general not feasible. Later on, a condition number estimator\r
-* will be deployed to estimate the scaled condition number.\r
-* Here we just remove the underflowed part of the triangular\r
-* factor. This prevents the situation in which the code is\r
-* working hard to get the accuracy not warranted by the data.\r
- TEMP1 = SQRT(SFMIN)\r
- DO 3301 p = 2, N\r
- IF ( ( ABS(A(p,p)) .LT. SMALL ) .OR.\r
- $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3302\r
- NR = NR + 1\r
- 3301 CONTINUE\r
- 3302 CONTINUE\r
-*\r
- END IF\r
-*\r
- ALMORT = .FALSE.\r
- IF ( NR .EQ. N ) THEN\r
- MAXPRJ = ONE\r
- DO 3051 p = 2, N\r
- TEMP1 = ABS(A(p,p)) / SVA(IWORK(p))\r
- MAXPRJ = MIN( MAXPRJ, TEMP1 )\r
- 3051 CONTINUE\r
- IF ( MAXPRJ**2 .GE. ONE - DBLE(N)*EPSLN ) ALMORT = .TRUE.\r
- END IF\r
-*\r
-*\r
- SCONDA = - ONE\r
- CONDR1 = - ONE\r
- CONDR2 = - ONE\r
-*\r
- IF ( ERREST ) THEN\r
- IF ( N .EQ. NR ) THEN\r
- IF ( RSVEC ) THEN\r
-* .. V is available as workspace\r
- CALL ZLACPY( 'U', N, N, A, LDA, V, LDV )\r
- DO 3053 p = 1, N\r
- TEMP1 = SVA(IWORK(p))\r
- CALL ZDSCAL( p, ONE/TEMP1, V(1,p), 1 )\r
- 3053 CONTINUE\r
- IF ( LSVEC )THEN\r
- CALL ZPOCON( 'U', N, V, LDV, ONE, TEMP1,\r
- $ CWORK(N+1), RWORK, IERR )\r
- ELSE\r
- CALL ZPOCON( 'U', N, V, LDV, ONE, TEMP1,\r
- $ CWORK, RWORK, IERR )\r
- END IF \r
-* \r
- ELSE IF ( LSVEC ) THEN\r
-* .. U is available as workspace\r
- CALL ZLACPY( 'U', N, N, A, LDA, U, LDU )\r
- DO 3054 p = 1, N\r
- TEMP1 = SVA(IWORK(p))\r
- CALL ZDSCAL( p, ONE/TEMP1, U(1,p), 1 )\r
- 3054 CONTINUE\r
- CALL ZPOCON( 'U', N, U, LDU, ONE, TEMP1,\r
- $ CWORK(N+1), RWORK, IERR )\r
- ELSE\r
- CALL ZLACPY( 'U', N, N, A, LDA, CWORK, N )\r
-*[] CALL ZLACPY( 'U', N, N, A, LDA, CWORK(N+1), N )\r
-* Change: here index shifted by N to the left, CWORK(1:N) \r
-* not needed for SIGMA only computation\r
- DO 3052 p = 1, N\r
- TEMP1 = SVA(IWORK(p))\r
-*[] CALL ZDSCAL( p, ONE/TEMP1, CWORK(N+(p-1)*N+1), 1 )\r
- CALL ZDSCAL( p, ONE/TEMP1, CWORK((p-1)*N+1), 1 )\r
- 3052 CONTINUE\r
-* .. the columns of R are scaled to have unit Euclidean lengths.\r
-*[] CALL ZPOCON( 'U', N, CWORK(N+1), N, ONE, TEMP1,\r
-*[] $ CWORK(N+N*N+1), RWORK, IERR )\r
- CALL ZPOCON( 'U', N, CWORK, N, ONE, TEMP1,\r
- $ CWORK(N*N+1), RWORK, IERR ) \r
-* \r
- END IF\r
- IF ( TEMP1 .NE. ZERO ) THEN \r
- SCONDA = ONE / SQRT(TEMP1)\r
- ELSE\r
- SCONDA = - ONE\r
- END IF\r
-* SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1).\r
-* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA\r
- ELSE\r
- SCONDA = - ONE\r
- END IF\r
- END IF\r
-*\r
- L2PERT = L2PERT .AND. ( ABS( A(1,1)/A(NR,NR) ) .GT. SQRT(BIG1) )\r
-* If there is no violent scaling, artificial perturbation is not needed.\r
-*\r
-* Phase 3:\r
-*\r
- IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN\r
-*\r
-* Singular Values only\r
-*\r
-* .. transpose A(1:NR,1:N)\r
- DO 1946 p = 1, MIN( N-1, NR )\r
- CALL ZCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 )\r
- CALL ZLACGV( N-p+1, A(p,p), 1 )\r
- 1946 CONTINUE\r
- IF ( NR .EQ. N ) A(N,N) = CONJG(A(N,N))\r
-*\r
-* The following two DO-loops introduce small relative perturbation\r
-* into the strict upper triangle of the lower triangular matrix.\r
-* Small entries below the main diagonal are also changed.\r
-* This modification is useful if the computing environment does not\r
-* provide/allow FLUSH TO ZERO underflow, for it prevents many\r
-* annoying denormalized numbers in case of strongly scaled matrices.\r
-* The perturbation is structured so that it does not introduce any\r
-* new perturbation of the singular values, and it does not destroy\r
-* the job done by the preconditioner.\r
-* The licence for this perturbation is in the variable L2PERT, which\r
-* should be .FALSE. if FLUSH TO ZERO underflow is active.\r
-*\r
- IF ( .NOT. ALMORT ) THEN\r
-*\r
- IF ( L2PERT ) THEN\r
-* XSC = SQRT(SMALL)\r
- XSC = EPSLN / DBLE(N)\r
- DO 4947 q = 1, NR\r
- CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO)\r
- DO 4949 p = 1, N\r
- IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )\r
- $ .OR. ( p .LT. q ) )\r
-* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) )\r
- $ A(p,q) = CTEMP\r
- 4949 CONTINUE\r
- 4947 CONTINUE\r
- ELSE\r
- CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, A(1,2),LDA )\r
- END IF\r
-*\r
-* .. second preconditioning using the QR factorization\r
-*\r
- CALL ZGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, IERR )\r
-*\r
-* .. and transpose upper to lower triangular\r
- DO 1948 p = 1, NR - 1\r
- CALL ZCOPY( NR-p, A(p,p+1), LDA, A(p+1,p), 1 )\r
- CALL ZLACGV( NR-p+1, A(p,p), 1 )\r
- 1948 CONTINUE\r
-*\r
- END IF\r
-*\r
-* Row-cyclic Jacobi SVD algorithm with column pivoting\r
-*\r
-* .. again some perturbation (a "background noise") is added\r
-* to drown denormals\r
- IF ( L2PERT ) THEN\r
-* XSC = SQRT(SMALL)\r
- XSC = EPSLN / DBLE(N)\r
- DO 1947 q = 1, NR\r
- CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO)\r
- DO 1949 p = 1, NR\r
- IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )\r
- $ .OR. ( p .LT. q ) )\r
-* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) )\r
- $ A(p,q) = CTEMP\r
- 1949 CONTINUE\r
- 1947 CONTINUE\r
- ELSE\r
- CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), LDA )\r
- END IF\r
-*\r
-* .. and one-sided Jacobi rotations are started on a lower\r
-* triangular matrix (plus perturbation which is ignored in\r
-* the part which destroys triangular form (confusing?!))\r
-*\r
- CALL ZGESVJ( 'L', 'N', 'N', NR, NR, A, LDA, SVA,\r
- $ N, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO )\r
-*\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
-*\r
-*\r
- ELSE IF ( ( RSVEC .AND. ( .NOT. LSVEC ) .AND. ( .NOT. JRACC ) )\r
- $ .OR. \r
- $ ( JRACC .AND. ( .NOT. LSVEC ) .AND. ( NR .NE. N ) ) ) THEN\r
-*\r
-* -> Singular Values and Right Singular Vectors <-\r
-*\r
- IF ( ALMORT ) THEN\r
-*\r
-* .. in this case NR equals N\r
- DO 1998 p = 1, NR\r
- CALL ZCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )\r
- CALL ZLACGV( N-p+1, V(p,p), 1 )\r
- 1998 CONTINUE\r
- CALL ZLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV )\r
-*\r
- CALL ZGESVJ( 'L','U','N', N, NR, V, LDV, SVA, NR, A, LDA,\r
- $ CWORK, LWORK, RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
-\r
- ELSE\r
-*\r
-* .. two more QR factorizations ( one QRF is not enough, two require\r
-* accumulated product of Jacobi rotations, three are perfect )\r
-*\r
- CALL ZLASET( 'L', NR-1,NR-1, CZERO, CZERO, A(2,1), LDA )\r
- CALL ZGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, IERR)\r
- CALL ZLACPY( 'L', NR, NR, A, LDA, V, LDV )\r
- CALL ZLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV )\r
- CALL ZGEQRF( NR, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),\r
- $ LWORK-2*N, IERR )\r
- DO 8998 p = 1, NR\r
- CALL ZCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 )\r
- CALL ZLACGV( NR-p+1, V(p,p), 1 )\r
- 8998 CONTINUE\r
- CALL ZLASET('U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV)\r
-*\r
- CALL ZGESVJ( 'L', 'U','N', NR, NR, V,LDV, SVA, NR, U,\r
- $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- IF ( NR .LT. N ) THEN\r
- CALL ZLASET( 'A',N-NR, NR, CZERO,CZERO, V(NR+1,1), LDV )\r
- CALL ZLASET( 'A',NR, N-NR, CZERO,CZERO, V(1,NR+1), LDV )\r
- CALL ZLASET( 'A',N-NR,N-NR,CZERO,CONE, V(NR+1,NR+1),LDV )\r
- END IF\r
-*\r
- CALL ZUNMLQ( 'L', 'C', N, N, NR, A, LDA, CWORK,\r
- $ V, LDV, CWORK(N+1), LWORK-N, IERR )\r
-*\r
- END IF\r
-* .. permute the rows of V\r
-* DO 8991 p = 1, N\r
-* CALL ZCOPY( N, V(p,1), LDV, A(IWORK(p),1), LDA )\r
-* 8991 CONTINUE\r
-* CALL ZLACPY( 'All', N, N, A, LDA, V, LDV )\r
- CALL ZLAPMR( .FALSE., N, N, V, LDV, IWORK )\r
-*\r
- IF ( TRANSP ) THEN\r
- CALL ZLACPY( 'A', N, N, V, LDV, U, LDU )\r
- END IF\r
-*\r
- ELSE IF ( JRACC .AND. (.NOT. LSVEC) .AND. ( NR.EQ. N ) ) THEN \r
-* \r
- CALL ZLASET( 'L', N-1,N-1, CZERO, CZERO, A(2,1), LDA )\r
-*\r
- CALL ZGESVJ( 'U','N','V', N, N, A, LDA, SVA, N, V, LDV,\r
- $ CWORK, LWORK, RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- CALL ZLAPMR( .FALSE., N, N, V, LDV, IWORK )\r
-*\r
- ELSE IF ( LSVEC .AND. ( .NOT. RSVEC ) ) THEN\r
-*\r
-* .. Singular Values and Left Singular Vectors ..\r
-*\r
-* .. second preconditioning step to avoid need to accumulate\r
-* Jacobi rotations in the Jacobi iterations.\r
- DO 1965 p = 1, NR\r
- CALL ZCOPY( N-p+1, A(p,p), LDA, U(p,p), 1 )\r
- CALL ZLACGV( N-p+1, U(p,p), 1 )\r
- 1965 CONTINUE\r
- CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )\r
-*\r
- CALL ZGEQRF( N, NR, U, LDU, CWORK(N+1), CWORK(2*N+1),\r
- $ LWORK-2*N, IERR )\r
-*\r
- DO 1967 p = 1, NR - 1\r
- CALL ZCOPY( NR-p, U(p,p+1), LDU, U(p+1,p), 1 )\r
- CALL ZLACGV( N-p+1, U(p,p), 1 )\r
- 1967 CONTINUE\r
- CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )\r
-*\r
- CALL ZGESVJ( 'L', 'U', 'N', NR,NR, U, LDU, SVA, NR, A,\r
- $ LDA, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
-*\r
- IF ( NR .LT. M ) THEN\r
- CALL ZLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), LDU )\r
- IF ( NR .LT. N1 ) THEN\r
- CALL ZLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU )\r
- CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1),LDU )\r
- END IF\r
- END IF\r
-*\r
- CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,\r
- $ LDU, CWORK(N+1), LWORK-N, IERR )\r
-*\r
- IF ( ROWPIV )\r
- $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )\r
-*\r
- DO 1974 p = 1, N1\r
- XSC = ONE / DZNRM2( M, U(1,p), 1 )\r
- CALL ZDSCAL( M, XSC, U(1,p), 1 )\r
- 1974 CONTINUE\r
-*\r
- IF ( TRANSP ) THEN\r
- CALL ZLACPY( 'A', N, N, U, LDU, V, LDV )\r
- END IF\r
-*\r
- ELSE\r
-*\r
-* .. Full SVD ..\r
-*\r
- IF ( .NOT. JRACC ) THEN\r
-*\r
- IF ( .NOT. ALMORT ) THEN\r
-*\r
-* Second Preconditioning Step (QRF [with pivoting])\r
-* Note that the composition of TRANSPOSE, QRF and TRANSPOSE is\r
-* equivalent to an LQF CALL. Since in many libraries the QRF\r
-* seems to be better optimized than the LQF, we do explicit\r
-* transpose and use the QRF. This is subject to changes in an\r
-* optimized implementation of ZGEJSV.\r
-*\r
- DO 1968 p = 1, NR\r
- CALL ZCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )\r
- CALL ZLACGV( N-p+1, V(p,p), 1 )\r
- 1968 CONTINUE\r
-*\r
-* .. the following two loops perturb small entries to avoid\r
-* denormals in the second QR factorization, where they are\r
-* as good as zeros. This is done to avoid painfully slow\r
-* computation with denormals. The relative size of the perturbation\r
-* is a parameter that can be changed by the implementer.\r
-* This perturbation device will be obsolete on machines with\r
-* properly implemented arithmetic.\r
-* To switch it off, set L2PERT=.FALSE. To remove it from the\r
-* code, remove the action under L2PERT=.TRUE., leave the ELSE part.\r
-* The following two loops should be blocked and fused with the\r
-* transposed copy above.\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 2969 q = 1, NR\r
- CTEMP = DCMPLX(XSC*ABS( V(q,q) ),ZERO)\r
- DO 2968 p = 1, N\r
- IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )\r
- $ .OR. ( p .LT. q ) )\r
-* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) )\r
- $ V(p,q) = CTEMP\r
- IF ( p .LT. q ) V(p,q) = - V(p,q)\r
- 2968 CONTINUE\r
- 2969 CONTINUE\r
- ELSE\r
- CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV )\r
- END IF\r
-*\r
-* Estimate the row scaled condition number of R1\r
-* (If R1 is rectangular, N > NR, then the condition number\r
-* of the leading NR x NR submatrix is estimated.)\r
-*\r
- CALL ZLACPY( 'L', NR, NR, V, LDV, CWORK(2*N+1), NR )\r
- DO 3950 p = 1, NR\r
- TEMP1 = DZNRM2(NR-p+1,CWORK(2*N+(p-1)*NR+p),1)\r
- CALL ZDSCAL(NR-p+1,ONE/TEMP1,CWORK(2*N+(p-1)*NR+p),1)\r
- 3950 CONTINUE\r
- CALL ZPOCON('L',NR,CWORK(2*N+1),NR,ONE,TEMP1,\r
- $ CWORK(2*N+NR*NR+1),RWORK,IERR)\r
- CONDR1 = ONE / SQRT(TEMP1)\r
-* .. here need a second oppinion on the condition number\r
-* .. then assume worst case scenario\r
-* R1 is OK for inverse <=> CONDR1 .LT. DBLE(N)\r
-* more conservative <=> CONDR1 .LT. SQRT(DBLE(N))\r
-*\r
- COND_OK = SQRT(SQRT(DBLE(NR)))\r
-*[TP] COND_OK is a tuning parameter.\r
-*\r
- IF ( CONDR1 .LT. COND_OK ) THEN\r
-* .. the second QRF without pivoting. Note: in an optimized\r
-* implementation, this QRF should be implemented as the QRF\r
-* of a lower triangular matrix.\r
-* R1^* = Q2 * R2\r
- CALL ZGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),\r
- $ LWORK-2*N, IERR )\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)/EPSLN\r
- DO 3959 p = 2, NR\r
- DO 3958 q = 1, p - 1\r
- CTEMP=DCMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),\r
- $ ZERO)\r
- IF ( ABS(V(q,p)) .LE. TEMP1 )\r
-* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) )\r
- $ V(q,p) = CTEMP\r
- 3958 CONTINUE\r
- 3959 CONTINUE\r
- END IF\r
-*\r
- IF ( NR .NE. N )\r
- $ CALL ZLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N )\r
-* .. save ...\r
-*\r
-* .. this transposed copy should be better than naive\r
- DO 1969 p = 1, NR - 1\r
- CALL ZCOPY( NR-p, V(p,p+1), LDV, V(p+1,p), 1 )\r
- CALL ZLACGV(NR-p+1, V(p,p), 1 )\r
- 1969 CONTINUE\r
- V(NR,NR)=CONJG(V(NR,NR))\r
-*\r
- CONDR2 = CONDR1\r
-*\r
- ELSE\r
-*\r
-* .. ill-conditioned case: second QRF with pivoting\r
-* Note that windowed pivoting would be equaly good\r
-* numerically, and more run-time efficient. So, in\r
-* an optimal implementation, the next call to ZGEQP3\r
-* should be replaced with eg. CALL ZGEQPX (ACM TOMS #782)\r
-* with properly (carefully) chosen parameters.\r
-*\r
-* R1^* * P2 = Q2 * R2\r
- DO 3003 p = 1, NR\r
- IWORK(N+p) = 0\r
- 3003 CONTINUE\r
- CALL ZGEQP3( N, NR, V, LDV, IWORK(N+1), CWORK(N+1),\r
- $ CWORK(2*N+1), LWORK-2*N, RWORK, IERR )\r
-** CALL ZGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),\r
-** $ LWORK-2*N, IERR )\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 3969 p = 2, NR\r
- DO 3968 q = 1, p - 1\r
- CTEMP=DCMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),\r
- $ ZERO)\r
- IF ( ABS(V(q,p)) .LE. TEMP1 )\r
-* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) )\r
- $ V(q,p) = CTEMP\r
- 3968 CONTINUE\r
- 3969 CONTINUE\r
- END IF\r
-*\r
- CALL ZLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N )\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 8970 p = 2, NR\r
- DO 8971 q = 1, p - 1\r
- CTEMP=DCMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),\r
- $ ZERO)\r
-* V(p,q) = - TEMP1*( V(q,p) / ABS(V(q,p)) )\r
- V(p,q) = - CTEMP\r
- 8971 CONTINUE\r
- 8970 CONTINUE\r
- ELSE\r
- CALL ZLASET( 'L',NR-1,NR-1,CZERO,CZERO,V(2,1),LDV )\r
- END IF\r
-* Now, compute R2 = L3 * Q3, the LQ factorization.\r
- CALL ZGELQF( NR, NR, V, LDV, CWORK(2*N+N*NR+1),\r
- $ CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, IERR )\r
-* .. and estimate the condition number\r
- CALL ZLACPY( 'L',NR,NR,V,LDV,CWORK(2*N+N*NR+NR+1),NR )\r
- DO 4950 p = 1, NR\r
- TEMP1 = DZNRM2( p, CWORK(2*N+N*NR+NR+p), NR )\r
- CALL ZDSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), NR )\r
- 4950 CONTINUE\r
- CALL ZPOCON( 'L',NR,CWORK(2*N+N*NR+NR+1),NR,ONE,TEMP1,\r
- $ CWORK(2*N+N*NR+NR+NR*NR+1),RWORK,IERR )\r
- CONDR2 = ONE / SQRT(TEMP1)\r
-*\r
-*\r
- IF ( CONDR2 .GE. COND_OK ) THEN\r
-* .. save the Householder vectors used for Q3\r
-* (this overwrittes the copy of R2, as it will not be\r
-* needed in this branch, but it does not overwritte the\r
-* Huseholder vectors of Q2.).\r
- CALL ZLACPY( 'U', NR, NR, V, LDV, CWORK(2*N+1), N )\r
-* .. and the rest of the information on Q3 is in\r
-* WORK(2*N+N*NR+1:2*N+N*NR+N)\r
- END IF\r
-*\r
- END IF\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 4968 q = 2, NR\r
- CTEMP = XSC * V(q,q)\r
- DO 4969 p = 1, q - 1\r
-* V(p,q) = - TEMP1*( V(p,q) / ABS(V(p,q)) )\r
- V(p,q) = - CTEMP\r
- 4969 CONTINUE\r
- 4968 CONTINUE\r
- ELSE\r
- CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV )\r
- END IF\r
-*\r
-* Second preconditioning finished; continue with Jacobi SVD\r
-* The input matrix is lower trinagular.\r
-*\r
-* Recover the right singular vectors as solution of a well\r
-* conditioned triangular matrix equation.\r
-*\r
- IF ( CONDR1 .LT. COND_OK ) THEN\r
-*\r
- CALL ZGESVJ( 'L','U','N',NR,NR,V,LDV,SVA,NR,U, LDU,\r
- $ CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,RWORK,\r
- $ LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- DO 3970 p = 1, NR\r
- CALL ZCOPY( NR, V(1,p), 1, U(1,p), 1 )\r
- CALL ZDSCAL( NR, SVA(p), V(1,p), 1 )\r
- 3970 CONTINUE\r
-\r
-* .. pick the right matrix equation and solve it\r
-*\r
- IF ( NR .EQ. N ) THEN\r
-* :)) .. best case, R1 is inverted. The solution of this matrix\r
-* equation is Q2*V2 = the product of the Jacobi rotations\r
-* used in ZGESVJ, premultiplied with the orthogonal matrix\r
-* from the second QR factorization.\r
- CALL ZTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V,LDV)\r
- ELSE\r
-* .. R1 is well conditioned, but non-square. Adjoint of R2\r
-* is inverted to get the product of the Jacobi rotations\r
-* used in ZGESVJ. The Q-factor from the second QR\r
-* factorization is then built in explicitly.\r
- CALL ZTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1),\r
- $ N,V,LDV)\r
- IF ( NR .LT. N ) THEN\r
- CALL ZLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV)\r
- CALL ZLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV)\r
- CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)\r
- END IF\r
- CALL ZUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),\r
- $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR)\r
- END IF\r
-*\r
- ELSE IF ( CONDR2 .LT. COND_OK ) THEN\r
-*\r
-* The matrix R2 is inverted. The solution of the matrix equation\r
-* is Q3^* * V3 = the product of the Jacobi rotations (appplied to\r
-* the lower triangular L3 from the LQ factorization of\r
-* R2=L3*Q3), pre-multiplied with the transposed Q3.\r
- CALL ZGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U,\r
- $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR,\r
- $ RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- DO 3870 p = 1, NR\r
- CALL ZCOPY( NR, V(1,p), 1, U(1,p), 1 )\r
- CALL ZDSCAL( NR, SVA(p), U(1,p), 1 )\r
- 3870 CONTINUE\r
- CALL ZTRSM('L','U','N','N',NR,NR,CONE,CWORK(2*N+1),N,\r
- $ U,LDU)\r
-* .. apply the permutation from the second QR factorization\r
- DO 873 q = 1, NR\r
- DO 872 p = 1, NR\r
- CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)\r
- 872 CONTINUE\r
- DO 874 p = 1, NR\r
- U(p,q) = CWORK(2*N+N*NR+NR+p)\r
- 874 CONTINUE\r
- 873 CONTINUE\r
- IF ( NR .LT. N ) THEN\r
- CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )\r
- CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )\r
- CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)\r
- END IF\r
- CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),\r
- $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )\r
- ELSE\r
-* Last line of defense.\r
-* #:( This is a rather pathological case: no scaled condition\r
-* improvement after two pivoted QR factorizations. Other\r
-* possibility is that the rank revealing QR factorization\r
-* or the condition estimator has failed, or the COND_OK\r
-* is set very close to ONE (which is unnecessary). Normally,\r
-* this branch should never be executed, but in rare cases of\r
-* failure of the RRQR or condition estimator, the last line of\r
-* defense ensures that ZGEJSV completes the task.\r
-* Compute the full SVD of L3 using ZGESVJ with explicit\r
-* accumulation of Jacobi rotations.\r
- CALL ZGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U,\r
- $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR,\r
- $ RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- IF ( NR .LT. N ) THEN\r
- CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )\r
- CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )\r
- CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)\r
- END IF\r
- CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),\r
- $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )\r
-*\r
- CALL ZUNMLQ( 'L', 'C', NR, NR, NR, CWORK(2*N+1), N,\r
- $ CWORK(2*N+N*NR+1), U, LDU, CWORK(2*N+N*NR+NR+1),\r
- $ LWORK-2*N-N*NR-NR, IERR )\r
- DO 773 q = 1, NR\r
- DO 772 p = 1, NR\r
- CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)\r
- 772 CONTINUE\r
- DO 774 p = 1, NR\r
- U(p,q) = CWORK(2*N+N*NR+NR+p)\r
- 774 CONTINUE\r
- 773 CONTINUE\r
-*\r
- END IF\r
-*\r
-* Permute the rows of V using the (column) permutation from the\r
-* first QRF. Also, scale the columns to make them unit in\r
-* Euclidean norm. This applies to all cases.\r
-*\r
- TEMP1 = SQRT(DBLE(N)) * EPSLN\r
- DO 1972 q = 1, N\r
- DO 972 p = 1, N\r
- CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)\r
- 972 CONTINUE\r
- DO 973 p = 1, N\r
- V(p,q) = CWORK(2*N+N*NR+NR+p)\r
- 973 CONTINUE\r
- XSC = ONE / DZNRM2( N, V(1,q), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL ZDSCAL( N, XSC, V(1,q), 1 )\r
- 1972 CONTINUE\r
-* At this moment, V contains the right singular vectors of A.\r
-* Next, assemble the left singular vector matrix U (M x N).\r
- IF ( NR .LT. M ) THEN\r
- CALL ZLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU)\r
- IF ( NR .LT. N1 ) THEN\r
- CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU)\r
- CALL ZLASET('A',M-NR,N1-NR,CZERO,CONE,\r
- $ U(NR+1,NR+1),LDU)\r
- END IF\r
- END IF\r
-*\r
-* The Q matrix from the first QRF is built into the left singular\r
-* matrix U. This applies to all cases.\r
-*\r
- CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,\r
- $ LDU, CWORK(N+1), LWORK-N, IERR )\r
-\r
-* The columns of U are normalized. The cost is O(M*N) flops.\r
- TEMP1 = SQRT(DBLE(M)) * EPSLN\r
- DO 1973 p = 1, NR\r
- XSC = ONE / DZNRM2( M, U(1,p), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL ZDSCAL( M, XSC, U(1,p), 1 )\r
- 1973 CONTINUE\r
-*\r
-* If the initial QRF is computed with row pivoting, the left\r
-* singular vectors must be adjusted.\r
-*\r
- IF ( ROWPIV )\r
- $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )\r
-*\r
- ELSE\r
-*\r
-* .. the initial matrix A has almost orthogonal columns and\r
-* the second QRF is not needed\r
-*\r
- CALL ZLACPY( 'U', N, N, A, LDA, CWORK(N+1), N )\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL)\r
- DO 5970 p = 2, N\r
- CTEMP = XSC * CWORK( N + (p-1)*N + p )\r
- DO 5971 q = 1, p - 1\r
-* CWORK(N+(q-1)*N+p)=-TEMP1 * ( CWORK(N+(p-1)*N+q) /\r
-* $ ABS(CWORK(N+(p-1)*N+q)) )\r
- CWORK(N+(q-1)*N+p)=-CTEMP\r
- 5971 CONTINUE\r
- 5970 CONTINUE\r
- ELSE\r
- CALL ZLASET( 'L',N-1,N-1,CZERO,CZERO,CWORK(N+2),N )\r
- END IF\r
-*\r
- CALL ZGESVJ( 'U', 'U', 'N', N, N, CWORK(N+1), N, SVA,\r
- $ N, U, LDU, CWORK(N+N*N+1), LWORK-N-N*N, RWORK, LRWORK,\r
- $ INFO )\r
-*\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
- DO 6970 p = 1, N\r
- CALL ZCOPY( N, CWORK(N+(p-1)*N+1), 1, U(1,p), 1 )\r
- CALL ZDSCAL( N, SVA(p), CWORK(N+(p-1)*N+1), 1 )\r
- 6970 CONTINUE\r
-*\r
- CALL ZTRSM( 'L', 'U', 'N', 'N', N, N,\r
- $ CONE, A, LDA, CWORK(N+1), N )\r
- DO 6972 p = 1, N\r
- CALL ZCOPY( N, CWORK(N+p), N, V(IWORK(p),1), LDV )\r
- 6972 CONTINUE\r
- TEMP1 = SQRT(DBLE(N))*EPSLN\r
- DO 6971 p = 1, N\r
- XSC = ONE / DZNRM2( N, V(1,p), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL ZDSCAL( N, XSC, V(1,p), 1 )\r
- 6971 CONTINUE\r
-*\r
-* Assemble the left singular vector matrix U (M x N).\r
-*\r
- IF ( N .LT. M ) THEN\r
- CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), LDU )\r
- IF ( N .LT. N1 ) THEN\r
- CALL ZLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1),LDU)\r
- CALL ZLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1),LDU)\r
- END IF\r
- END IF\r
- CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,\r
- $ LDU, CWORK(N+1), LWORK-N, IERR )\r
- TEMP1 = SQRT(DBLE(M))*EPSLN\r
- DO 6973 p = 1, N1\r
- XSC = ONE / DZNRM2( M, U(1,p), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL ZDSCAL( M, XSC, U(1,p), 1 )\r
- 6973 CONTINUE\r
-*\r
- IF ( ROWPIV )\r
- $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )\r
-*\r
- END IF\r
-*\r
-* end of the >> almost orthogonal case << in the full SVD\r
-*\r
- ELSE\r
-*\r
-* This branch deploys a preconditioned Jacobi SVD with explicitly\r
-* accumulated rotations. It is included as optional, mainly for\r
-* experimental purposes. It does perfom well, and can also be used.\r
-* In this implementation, this branch will be automatically activated\r
-* if the condition number sigma_max(A) / sigma_min(A) is predicted\r
-* to be greater than the overflow threshold. This is because the\r
-* a posteriori computation of the singular vectors assumes robust\r
-* implementation of BLAS and some LAPACK procedures, capable of working\r
-* in presence of extreme values, e.g. when the singular values spread from\r
-* the underflow to the overflow threshold. \r
-*\r
- DO 7968 p = 1, NR\r
- CALL ZCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )\r
- CALL ZLACGV( N-p+1, V(p,p), 1 )\r
- 7968 CONTINUE\r
-*\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL/EPSLN)\r
- DO 5969 q = 1, NR\r
- CTEMP = DCMPLX(XSC*ABS( V(q,q) ),ZERO)\r
- DO 5968 p = 1, N\r
- IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )\r
- $ .OR. ( p .LT. q ) )\r
-* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) )\r
- $ V(p,q) = CTEMP\r
- IF ( p .LT. q ) V(p,q) = - V(p,q)\r
- 5968 CONTINUE\r
- 5969 CONTINUE\r
- ELSE\r
- CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV )\r
- END IF\r
-\r
- CALL ZGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),\r
- $ LWORK-2*N, IERR )\r
- CALL ZLACPY( 'L', N, NR, V, LDV, CWORK(2*N+1), N )\r
-*\r
- DO 7969 p = 1, NR\r
- CALL ZCOPY( NR-p+1, V(p,p), LDV, U(p,p), 1 )\r
- CALL ZLACGV( NR-p+1, U(p,p), 1 )\r
- 7969 CONTINUE\r
-\r
- IF ( L2PERT ) THEN\r
- XSC = SQRT(SMALL/EPSLN)\r
- DO 9970 q = 2, NR\r
- DO 9971 p = 1, q - 1\r
- CTEMP = DCMPLX(XSC * MIN(ABS(U(p,p)),ABS(U(q,q))),\r
- $ ZERO)\r
-* U(p,q) = - TEMP1 * ( U(q,p) / ABS(U(q,p)) )\r
- U(p,q) = - CTEMP\r
- 9971 CONTINUE\r
- 9970 CONTINUE\r
- ELSE\r
- CALL ZLASET('U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )\r
- END IF\r
-\r
- CALL ZGESVJ( 'L', 'U', 'V', NR, NR, U, LDU, SVA,\r
- $ N, V, LDV, CWORK(2*N+N*NR+1), LWORK-2*N-N*NR,\r
- $ RWORK, LRWORK, INFO )\r
- SCALEM = RWORK(1)\r
- NUMRANK = NINT(RWORK(2))\r
-\r
- IF ( NR .LT. N ) THEN\r
- CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )\r
- CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )\r
- CALL ZLASET( 'A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV )\r
- END IF\r
-\r
- CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),\r
- $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )\r
-*\r
-* Permute the rows of V using the (column) permutation from the\r
-* first QRF. Also, scale the columns to make them unit in\r
-* Euclidean norm. This applies to all cases.\r
-*\r
- TEMP1 = SQRT(DBLE(N)) * EPSLN\r
- DO 7972 q = 1, N\r
- DO 8972 p = 1, N\r
- CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)\r
- 8972 CONTINUE\r
- DO 8973 p = 1, N\r
- V(p,q) = CWORK(2*N+N*NR+NR+p)\r
- 8973 CONTINUE\r
- XSC = ONE / DZNRM2( N, V(1,q), 1 )\r
- IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )\r
- $ CALL ZDSCAL( N, XSC, V(1,q), 1 )\r
- 7972 CONTINUE\r
-*\r
-* At this moment, V contains the right singular vectors of A.\r
-* Next, assemble the left singular vector matrix U (M x N).\r
-*\r
- IF ( NR .LT. M ) THEN\r
- CALL ZLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU )\r
- IF ( NR .LT. N1 ) THEN\r
- CALL ZLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU)\r
- CALL ZLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1),LDU)\r
- END IF\r
- END IF\r
-*\r
- CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,\r
- $ LDU, CWORK(N+1), LWORK-N, IERR )\r
-*\r
- IF ( ROWPIV )\r
- $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )\r
-*\r
-*\r
- END IF\r
- IF ( TRANSP ) THEN\r
-* .. swap U and V because the procedure worked on A^*\r
- DO 6974 p = 1, N\r
- CALL ZSWAP( N, U(1,p), 1, V(1,p), 1 )\r
- 6974 CONTINUE\r
- END IF\r
-*\r
- END IF\r
-* end of the full SVD\r
-*\r
-* Undo scaling, if necessary (and possible)\r
-*\r
- IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN\r
- CALL DLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR )\r
- USCAL1 = ONE\r
- USCAL2 = ONE\r
- END IF\r
-*\r
- IF ( NR .LT. N ) THEN\r
- DO 3004 p = NR+1, N\r
- SVA(p) = ZERO\r
- 3004 CONTINUE\r
- END IF\r
-*\r
- RWORK(1) = USCAL2 * SCALEM\r
- RWORK(2) = USCAL1\r
- IF ( ERREST ) RWORK(3) = SCONDA\r
- IF ( LSVEC .AND. RSVEC ) THEN\r
- RWORK(4) = CONDR1\r
- RWORK(5) = CONDR2\r
- END IF\r
- IF ( L2TRAN ) THEN\r
- RWORK(6) = ENTRA\r
- RWORK(7) = ENTRAT\r
- END IF\r
-*\r
- IWORK(1) = NR\r
- IWORK(2) = NUMRANK\r
- IWORK(3) = WARNING\r
- IF ( TRANSP ) THEN\r
- IWORK(4) = 1 \r
- ELSE\r
- IWORK(4) = -1\r
- END IF \r
- \r
-*\r
- RETURN\r
-* ..\r
-* .. END OF ZGEJSV\r
-* ..\r
- END\r
-*\r
+*> \brief \b ZGEJSV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZGEJSV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgejsv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgejsv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgejsv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
+* M, N, A, LDA, SVA, U, LDU, V, LDV,
+* CWORK, LWORK, RWORK, LRWORK, IWORK, INFO )
+*
+* .. Scalar Arguments ..
+* IMPLICIT NONE
+* INTEGER INFO, LDA, LDU, LDV, LWORK, M, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK )
+* DOUBLE PRECISION SVA( N ), RWORK( LRWORK )
+* INTEGER IWORK( * )
+* CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZGEJSV computes the singular value decomposition (SVD) of a complex M-by-N
+*> matrix [A], where M >= N. The SVD of [A] is written as
+*>
+*> [A] = [U] * [SIGMA] * [V]^*,
+*>
+*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N
+*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and
+*> [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are
+*> the singular values of [A]. The columns of [U] and [V] are the left and
+*> the right singular vectors of [A], respectively. The matrices [U] and [V]
+*> are computed and stored in the arrays U and V, respectively. The diagonal
+*> of [SIGMA] is computed and stored in the array SVA.
+*> \endverbatim
+*>
+*> Arguments:
+*> ==========
+*>
+*> \param[in] JOBA
+*> \verbatim
+*> JOBA is CHARACTER*1
+*> Specifies the level of accuracy:
+*> = 'C': This option works well (high relative accuracy) if A = B * D,
+*> with well-conditioned B and arbitrary diagonal matrix D.
+*> The accuracy cannot be spoiled by COLUMN scaling. The
+*> accuracy of the computed output depends on the condition of
+*> B, and the procedure aims at the best theoretical accuracy.
+*> The relative error max_{i=1:N}|d sigma_i| / sigma_i is
+*> bounded by f(M,N)*epsilon* cond(B), independent of D.
+*> The input matrix is preprocessed with the QRF with column
+*> pivoting. This initial preprocessing and preconditioning by
+*> a rank revealing QR factorization is common for all values of
+*> JOBA. Additional actions are specified as follows:
+*> = 'E': Computation as with 'C' with an additional estimate of the
+*> condition number of B. It provides a realistic error bound.
+*> = 'F': If A = D1 * C * D2 with ill-conditioned diagonal scalings
+*> D1, D2, and well-conditioned matrix C, this option gives
+*> higher accuracy than the 'C' option. If the structure of the
+*> input matrix is not known, and relative accuracy is
+*> desirable, then this option is advisable. The input matrix A
+*> is preprocessed with QR factorization with FULL (row and
+*> column) pivoting.
+*> = 'G' Computation as with 'F' with an additional estimate of the
+*> condition number of B, where A=B*D. If A has heavily weighted
+*> rows, then using this condition number gives too pessimistic
+*> error bound.
+*> = 'A': Small singular values are not well determined by the data
+*> and are considered as noisy; the matrix is treated as
+*> numerically rank defficient. The error in the computed
+*> singular values is bounded by f(m,n)*epsilon*||A||.
+*> The computed SVD A = U * S * V^* restores A up to
+*> f(m,n)*epsilon*||A||.
+*> This gives the procedure the licence to discard (set to zero)
+*> all singular values below N*epsilon*||A||.
+*> = 'R': Similar as in 'A'. Rank revealing property of the initial
+*> QR factorization is used do reveal (using triangular factor)
+*> a gap sigma_{r+1} < epsilon * sigma_r in which case the
+*> numerical RANK is declared to be r. The SVD is computed with
+*> absolute error bounds, but more accurately than with 'A'.
+*> \endverbatim
+*>
+*> \param[in] JOBU
+*> \verbatim
+*> JOBU is CHARACTER*1
+*> Specifies whether to compute the columns of U:
+*> = 'U': N columns of U are returned in the array U.
+*> = 'F': full set of M left sing. vectors is returned in the array U.
+*> = 'W': U may be used as workspace of length M*N. See the description
+*> of U.
+*> = 'N': U is not computed.
+*> \endverbatim
+*>
+*> \param[in] JOBV
+*> \verbatim
+*> JOBV is CHARACTER*1
+*> Specifies whether to compute the matrix V:
+*> = 'V': N columns of V are returned in the array V; Jacobi rotations
+*> are not explicitly accumulated.
+*> = 'J': N columns of V are returned in the array V, but they are
+*> computed as the product of Jacobi rotations, if JOBT .EQ. 'N'.
+*> = 'W': V may be used as workspace of length N*N. See the description
+*> of V.
+*> = 'N': V is not computed.
+*> \endverbatim
+*>
+*> \param[in] JOBR
+*> \verbatim
+*> JOBR is CHARACTER*1
+*> Specifies the RANGE for the singular values. Issues the licence to
+*> set to zero small positive singular values if they are outside
+*> specified range. If A .NE. 0 is scaled so that the largest singular
+*> value of c*A is around SQRT(BIG), BIG=DLAMCH('O'), then JOBR issues
+*> the licence to kill columns of A whose norm in c*A is less than
+*> SQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN,
+*> where SFMIN=DLAMCH('S'), EPSLN=DLAMCH('E').
+*> = 'N': Do not kill small columns of c*A. This option assumes that
+*> BLAS and QR factorizations and triangular solvers are
+*> implemented to work in that range. If the condition of A
+*> is greater than BIG, use ZGESVJ.
+*> = 'R': RESTRICTED range for sigma(c*A) is [SQRT(SFMIN), SQRT(BIG)]
+*> (roughly, as described above). This option is recommended.
+*> ===========================
+*> For computing the singular values in the FULL range [SFMIN,BIG]
+*> use ZGESVJ.
+*> \endverbatim
+*>
+*> \param[in] JOBT
+*> \verbatim
+*> JOBT is CHARACTER*1
+*> If the matrix is square then the procedure may determine to use
+*> transposed A if A^* seems to be better with respect to convergence.
+*> If the matrix is not square, JOBT is ignored.
+*> The decision is based on two values of entropy over the adjoint
+*> orbit of A^* * A. See the descriptions of WORK(6) and WORK(7).
+*> = 'T': transpose if entropy test indicates possibly faster
+*> convergence of Jacobi process if A^* is taken as input. If A is
+*> replaced with A^*, then the row pivoting is included automatically.
+*> = 'N': do not speculate.
+*> The option 'T' can be used to compute only the singular values, or
+*> the full SVD (U, SIGMA and V). For only one set of singular vectors
+*> (U or V), the caller should provide both U and V, as one of the
+*> matrices is used as workspace if the matrix A is transposed.
+*> The implementer can easily remove this constraint and make the
+*> code more complicated. See the descriptions of U and V.
+*> In general, this option is considered experimental, and 'N'; should
+*> be preferred. This is subject to changes in the future.
+*> \endverbatim
+*>
+*> \param[in] JOBP
+*> \verbatim
+*> JOBP is CHARACTER*1
+*> Issues the licence to introduce structured perturbations to drown
+*> denormalized numbers. This licence should be active if the
+*> denormals are poorly implemented, causing slow computation,
+*> especially in cases of fast convergence (!). For details see [1,2].
+*> For the sake of simplicity, this perturbations are included only
+*> when the full SVD or only the singular values are requested. The
+*> implementer/user can easily add the perturbation for the cases of
+*> computing one set of singular vectors.
+*> = 'P': introduce perturbation
+*> = 'N': do not perturb
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the input matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the input matrix A. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the M-by-N matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] SVA
+*> \verbatim
+*> SVA is DOUBLE PRECISION array, dimension (N)
+*> On exit,
+*> - For WORK(1)/WORK(2) = ONE: The singular values of A. During the
+*> computation SVA contains Euclidean column norms of the
+*> iterated matrices in the array A.
+*> - For WORK(1) .NE. WORK(2): The singular values of A are
+*> (WORK(1)/WORK(2)) * SVA(1:N). This factored form is used if
+*> sigma_max(A) overflows or if small singular values have been
+*> saved from underflow by scaling the input matrix A.
+*> - If JOBR='R' then some of the singular values may be returned
+*> as exact zeros obtained by "set to zero" because they are
+*> below the numerical rank threshold or are denormalized numbers.
+*> \endverbatim
+*>
+*> \param[out] U
+*> \verbatim
+*> U is COMPLEX*16 array, dimension ( LDU, N )
+*> If JOBU = 'U', then U contains on exit the M-by-N matrix of
+*> the left singular vectors.
+*> If JOBU = 'F', then U contains on exit the M-by-M matrix of
+*> the left singular vectors, including an ONB
+*> of the orthogonal complement of the Range(A).
+*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N),
+*> then U is used as workspace if the procedure
+*> replaces A with A^*. In that case, [V] is computed
+*> in U as left singular vectors of A^* and then
+*> copied back to the V array. This 'W' option is just
+*> a reminder to the caller that in this case U is
+*> reserved as workspace of length N*N.
+*> If JOBU = 'N' U is not referenced, unless JOBT='T'.
+*> \endverbatim
+*>
+*> \param[in] LDU
+*> \verbatim
+*> LDU is INTEGER
+*> The leading dimension of the array U, LDU >= 1.
+*> IF JOBU = 'U' or 'F' or 'W', then LDU >= M.
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*> V is COMPLEX*16 array, dimension ( LDV, N )
+*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of
+*> the right singular vectors;
+*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N),
+*> then V is used as workspace if the pprocedure
+*> replaces A with A^*. In that case, [U] is computed
+*> in V as right singular vectors of A^* and then
+*> copied back to the U array. This 'W' option is just
+*> a reminder to the caller that in this case V is
+*> reserved as workspace of length N*N.
+*> If JOBV = 'N' V is not referenced, unless JOBT='T'.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V, LDV >= 1.
+*> If JOBV = 'V' or 'J' or 'W', then LDV >= N.
+*> \endverbatim
+*>
+*> \param[out] CWORK
+*> \verbatim
+*> CWORK is COMPLEX*16 array, dimension (MAX(2,LWORK))
+*> If the call to ZGEJSV is a workspace query (indicated by LWORK=-1 or
+*> LRWORK=-1), then on exit CWORK(1) contains the required length of
+*> CWORK for the job parameters used in the call.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> Length of CWORK to confirm proper allocation of workspace.
+*> LWORK depends on the job:
+*>
+*> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and
+*> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'):
+*> LWORK >= 2*N+1. This is the minimal requirement.
+*> ->> For optimal performance (blocked code) the optimal value
+*> is LWORK >= N + (N+1)*NB. Here NB is the optimal
+*> block size for ZGEQP3 and ZGEQRF.
+*> In general, optimal LWORK is computed as
+*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZGEQRF), LWORK(ZGESVJ)).
+*> 1.2. .. an estimate of the scaled condition number of A is
+*> required (JOBA='E', or 'G'). In this case, LWORK the minimal
+*> requirement is LWORK >= N*N + 2*N.
+*> ->> For optimal performance (blocked code) the optimal value
+*> is LWORK >= max(N+(N+1)*NB, N*N+2*N)=N**2+2*N.
+*> In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZGEQRF), LWORK(ZGESVJ),
+*> N*N+LWORK(ZPOCON)).
+*> 2. If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'),
+*> (JOBU.EQ.'N')
+*> 2.1 .. no scaled condition estimate requested (JOBE.EQ.'N'):
+*> -> the minimal requirement is LWORK >= 3*N.
+*> -> For optimal performance,
+*> LWORK >= max(N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,
+*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQ,
+*> ZUNMLQ. In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(ZGEQP3), N+LWORK(ZGESVJ),
+*> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMLQ)).
+*> 2.2 .. an estimate of the scaled condition number of A is
+*> required (JOBA='E', or 'G').
+*> -> the minimal requirement is LWORK >= 3*N.
+*> -> For optimal performance,
+*> LWORK >= max(N+(N+1)*NB, 2*N,2*N+N*NB)=2*N+N*NB,
+*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQ,
+*> ZUNMLQ. In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(ZGEQP3), LWORK(ZPOCON), N+LWORK(ZGESVJ),
+*> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMLQ)).
+*> 3. If SIGMA and the left singular vectors are needed
+*> 3.1 .. no scaled condition estimate requested (JOBE.EQ.'N'):
+*> -> the minimal requirement is LWORK >= 3*N.
+*> -> For optimal performance:
+*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,
+*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZUNMQR.
+*> In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(ZGEQP3), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMQR)).
+*> 3.2 .. an estimate of the scaled condition number of A is
+*> required (JOBA='E', or 'G').
+*> -> the minimal requirement is LWORK >= 3*N.
+*> -> For optimal performance:
+*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB,
+*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZUNMQR.
+*> In general, the optimal length LWORK is computed as
+*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZPOCON),
+*> 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMQR)).
+*> 4. If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and
+*> 4.1. if JOBV.EQ.'V'
+*> the minimal requirement is LWORK >= 5*N+2*N*N.
+*> 4.2. if JOBV.EQ.'J' the minimal requirement is
+*> LWORK >= 4*N+N*N.
+*> In both cases, the allocated CWORK can accommodate blocked runs
+*> of ZGEQP3, ZGEQRF, ZGELQF, SUNMQR, ZUNMLQ.
+*>
+*> If the call to ZGEJSV is a workspace query (indicated by LWORK=-1 or
+*> LRWORK=-1), then on exit CWORK(1) contains the optimal and CWORK(2) contains the
+*> minimal length of CWORK for the job parameters used in the call.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is DOUBLE PRECISION array, dimension (MAX(7,LWORK))
+*> On exit,
+*> RWORK(1) = Determines the scaling factor SCALE = RWORK(2) / RWORK(1)
+*> such that SCALE*SVA(1:N) are the computed singular values
+*> of A. (See the description of SVA().)
+*> RWORK(2) = See the description of RWORK(1).
+*> RWORK(3) = SCONDA is an estimate for the condition number of
+*> column equilibrated A. (If JOBA .EQ. 'E' or 'G')
+*> SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1).
+*> It is computed using SPOCON. It holds
+*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA
+*> where R is the triangular factor from the QRF of A.
+*> However, if R is truncated and the numerical rank is
+*> determined to be strictly smaller than N, SCONDA is
+*> returned as -1, thus indicating that the smallest
+*> singular values might be lost.
+*>
+*> If full SVD is needed, the following two condition numbers are
+*> useful for the analysis of the algorithm. They are provied for
+*> a developer/implementer who is familiar with the details of
+*> the method.
+*>
+*> RWORK(4) = an estimate of the scaled condition number of the
+*> triangular factor in the first QR factorization.
+*> RWORK(5) = an estimate of the scaled condition number of the
+*> triangular factor in the second QR factorization.
+*> The following two parameters are computed if JOBT .EQ. 'T'.
+*> They are provided for a developer/implementer who is familiar
+*> with the details of the method.
+*> RWORK(6) = the entropy of A^* * A :: this is the Shannon entropy
+*> of diag(A^* * A) / Trace(A^* * A) taken as point in the
+*> probability simplex.
+*> RWORK(7) = the entropy of A * A^*. (See the description of RWORK(6).)
+*> If the call to ZGEJSV is a workspace query (indicated by LWORK=-1 or
+*> LRWORK=-1), then on exit RWORK(1) contains the required length of
+*> RWORK for the job parameters used in the call.
+*> \endverbatim
+*>
+*> \param[in] LRWORK
+*> \verbatim
+*> LRWORK is INTEGER
+*> Length of RWORK to confirm proper allocation of workspace.
+*> LRWORK depends on the job:
+*>
+*> 1. If only the singular values are requested i.e. if
+*> LSAME(JOBU,'N') .AND. LSAME(JOBV,'N')
+*> then:
+*> 1.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),
+*> then: LRWORK = max( 7, 2 * M ).
+*> 1.2. Otherwise, LRWORK = max( 7, N ).
+*> 2. If singular values with the right singular vectors are requested
+*> i.e. if
+*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) .AND.
+*> .NOT.(LSAME(JOBU,'U').OR.LSAME(JOBU,'F'))
+*> then:
+*> 2.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),
+*> then LRWORK = max( 7, 2 * M ).
+*> 2.2. Otherwise, LRWORK = max( 7, N ).
+*> 3. If singular values with the left singular vectors are requested, i.e. if
+*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND.
+*> .NOT.(LSAME(JOBV,'V').OR.LSAME(JOBV,'J'))
+*> then:
+*> 3.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),
+*> then LRWORK = max( 7, 2 * M ).
+*> 3.2. Otherwise, LRWORK = max( 7, N ).
+*> 4. If singular values with both the left and the right singular vectors
+*> are requested, i.e. if
+*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND.
+*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J'))
+*> then:
+*> 4.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'),
+*> then LRWORK = max( 7, 2 * M ).
+*> 4.2. Otherwise, LRWORK = max( 7, N ).
+*>
+*> If, on entry, LRWORK = -1 or LWORK=-1, a workspace query is assumed and
+*> the length of RWORK is returned in RWORK(1).
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, of dimension at least 4, that further depends
+*> on the job:
+*>
+*> 1. If only the singular values are requested then:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is N+M; otherwise the length of IWORK is N.
+*> 2. If the singular values and the right singular vectors are requested then:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is N+M; otherwise the length of IWORK is N.
+*> 3. If the singular values and the left singular vectors are requested then:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is N+M; otherwise the length of IWORK is N.
+*> 4. If the singular values with both the left and the right singular vectors
+*> are requested, then:
+*> 4.1. If LSAME(JOBV,'J') the length of IWORK is determined as follows:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is N+M; otherwise the length of IWORK is N.
+*> 4.2. If LSAME(JOBV,'V') the length of IWORK is determined as follows:
+*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') )
+*> then the length of IWORK is 2*N+M; otherwise the length of IWORK is 2*N.
+*>
+*> On exit,
+*> IWORK(1) = the numerical rank determined after the initial
+*> QR factorization with pivoting. See the descriptions
+*> of JOBA and JOBR.
+*> IWORK(2) = the number of the computed nonzero singular values
+*> IWORK(3) = if nonzero, a warning message:
+*> If IWORK(3).EQ.1 then some of the column norms of A
+*> were denormalized floats. The requested high accuracy
+*> is not warranted by the data.
+*> IWORK(4) = 1 or -1. If IWORK(4) .EQ. 1, then the procedure used A^* to
+*> do the job as specified by the JOB parameters.
+*> If the call to ZGEJSV is a workspace query (indicated by LWORK .EQ. -1 or
+*> LRWORK .EQ. -1), then on exit IWORK(1) contains the required length of
+*> IWORK for the job parameters used in the call.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> < 0 : if INFO = -i, then the i-th argument had an illegal value.
+*> = 0 : successful exit;
+*> > 0 : ZGEJSV did not converge in the maximal allowed number
+*> of sweeps. The computed values may be inaccurate.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date June 2016
+*
+*> \ingroup complex16GEsing
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> ZGEJSV implements a preconditioned Jacobi SVD algorithm. It uses ZGEQP3,
+*> ZGEQRF, and ZGELQF as preprocessors and preconditioners. Optionally, an
+*> additional row pivoting can be used as a preprocessor, which in some
+*> cases results in much higher accuracy. An example is matrix A with the
+*> structure A = D1 * C * D2, where D1, D2 are arbitrarily ill-conditioned
+*> diagonal matrices and C is well-conditioned matrix. In that case, complete
+*> pivoting in the first QR factorizations provides accuracy dependent on the
+*> condition number of C, and independent of D1, D2. Such higher accuracy is
+*> not completely understood theoretically, but it works well in practice.
+*> Further, if A can be written as A = B*D, with well-conditioned B and some
+*> diagonal D, then the high accuracy is guaranteed, both theoretically and
+*> in software, independent of D. For more details see [1], [2].
+*> The computational range for the singular values can be the full range
+*> ( UNDERFLOW,OVERFLOW ), provided that the machine arithmetic and the BLAS
+*> & LAPACK routines called by ZGEJSV are implemented to work in that range.
+*> If that is not the case, then the restriction for safe computation with
+*> the singular values in the range of normalized IEEE numbers is that the
+*> spectral condition number kappa(A)=sigma_max(A)/sigma_min(A) does not
+*> overflow. This code (ZGEJSV) is best used in this restricted range,
+*> meaning that singular values of magnitude below ||A||_2 / DLAMCH('O') are
+*> returned as zeros. See JOBR for details on this.
+*> Further, this implementation is somewhat slower than the one described
+*> in [1,2] due to replacement of some non-LAPACK components, and because
+*> the choice of some tuning parameters in the iterative part (ZGESVJ) is
+*> left to the implementer on a particular machine.
+*> The rank revealing QR factorization (in this code: ZGEQP3) should be
+*> implemented as in [3]. We have a new version of ZGEQP3 under development
+*> that is more robust than the current one in LAPACK, with a cleaner cut in
+*> rank deficient cases. It will be available in the SIGMA library [4].
+*> If M is much larger than N, it is obvious that the initial QRF with
+*> column pivoting can be preprocessed by the QRF without pivoting. That
+*> well known trick is not used in ZGEJSV because in some cases heavy row
+*> weighting can be treated with complete pivoting. The overhead in cases
+*> M much larger than N is then only due to pivoting, but the benefits in
+*> terms of accuracy have prevailed. The implementer/user can incorporate
+*> this extra QRF step easily. The implementer can also improve data movement
+*> (matrix transpose, matrix copy, matrix transposed copy) - this
+*> implementation of ZGEJSV uses only the simplest, naive data movement.
+*> \endverbatim
+*
+*> \par Contributor:
+* ==================
+*>
+*> Zlatko Drmac, Department of Mathematics, Faculty of Science,
+*> University of Zagreb (Zagreb, Croatia); drmac@math.hr
+*
+*> \par References:
+* ================
+*>
+*> \verbatim
+*>
+*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I.
+*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342.
+*> LAPACK Working note 169.
+*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II.
+*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362.
+*> LAPACK Working note 170.
+*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR
+*> factorization software - a case study.
+*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28.
+*> LAPACK Working note 176.
+*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV,
+*> QSVD, (H,K)-SVD computations.
+*> Department of Mathematics, University of Zagreb, 2008, 2016.
+*> \endverbatim
+*
+*> \par Bugs, examples and comments:
+* =================================
+*>
+*> Please report all bugs and send interesting examples and/or comments to
+*> drmac@math.hr. Thank you.
+*>
+* =====================================================================
+ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
+ $ M, N, A, LDA, SVA, U, LDU, V, LDV,
+ $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.7.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* June 2017
+*
+* .. Scalar Arguments ..
+ IMPLICIT NONE
+ INTEGER INFO, LDA, LDU, LDV, LWORK, LRWORK, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ),
+ $ CWORK( LWORK )
+ DOUBLE PRECISION SVA( N ), RWORK( LRWORK )
+ INTEGER IWORK( * )
+ CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV
+* ..
+*
+* ===========================================================================
+*
+* .. Local Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
+ COMPLEX*16 CZERO, CONE
+ PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ), CONE = ( 1.0D0, 0.0D0 ) )
+* ..
+* .. Local Scalars ..
+ COMPLEX*16 CTEMP
+ DOUBLE PRECISION AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1,
+ $ COND_OK, CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN,
+ $ MAXPRJ, SCALEM, SCONDA, SFMIN, SMALL, TEMP1,
+ $ USCAL1, USCAL2, XSC
+ INTEGER IERR, N1, NR, NUMRANK, p, q, WARNING
+ LOGICAL ALMORT, DEFR, ERREST, GOSCAL, JRACC, KILL, LQUERY,
+ $ LSVEC, L2ABER, L2KILL, L2PERT, L2RANK, L2TRAN, NOSCAL,
+ $ ROWPIV, RSVEC, TRANSP
+*
+ INTEGER OPTWRK, MINWRK, MINRWRK, MINIWRK
+ INTEGER LWCON, LWLQF, LWQP3, LWQRF, LWUNMLQ, LWUNMQR, LWUNMQRM,
+ $ LWSVDJ, LWSVDJV, LRWQP3, LRWCON, LRWSVDJ, IWOFF
+ INTEGER LWRK_ZGELQF, LWRK_ZGEQP3, LWRK_ZGEQP3N, LWRK_ZGEQRF,
+ $ LWRK_ZGESVJ, LWRK_ZGESVJV, LWRK_ZGESVJU, LWRK_ZUNMLQ,
+ $ LWRK_ZUNMQR, LWRK_ZUNMQRM
+* ..
+* .. Local Arrays
+ COMPLEX*16 CDUMMY(1)
+ DOUBLE PRECISION RDUMMY(1)
+*
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DCMPLX, CONJG, DLOG, MAX, MIN, DBLE, NINT, SQRT
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH, DZNRM2
+ INTEGER IDAMAX, IZAMAX
+ LOGICAL LSAME
+ EXTERNAL IDAMAX, IZAMAX, LSAME, DLAMCH, DZNRM2
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLASSQ, ZCOPY, ZGELQF, ZGEQP3, ZGEQRF, ZLACPY, ZLAPMR,
+ $ ZLASCL, DLASCL, ZLASET, ZLASSQ, ZLASWP, ZUNGQR, ZUNMLQ,
+ $ ZUNMQR, ZPOCON, DSCAL, ZDSCAL, ZSWAP, ZTRSM, ZLACGV,
+ $ XERBLA
+*
+ EXTERNAL ZGESVJ
+* ..
+*
+* Test the input arguments
+*
+ LSVEC = LSAME( JOBU, 'U' ) .OR. LSAME( JOBU, 'F' )
+ JRACC = LSAME( JOBV, 'J' )
+ RSVEC = LSAME( JOBV, 'V' ) .OR. JRACC
+ ROWPIV = LSAME( JOBA, 'F' ) .OR. LSAME( JOBA, 'G' )
+ L2RANK = LSAME( JOBA, 'R' )
+ L2ABER = LSAME( JOBA, 'A' )
+ ERREST = LSAME( JOBA, 'E' ) .OR. LSAME( JOBA, 'G' )
+ L2TRAN = LSAME( JOBT, 'T' ) .AND. ( M .EQ. N )
+ L2KILL = LSAME( JOBR, 'R' )
+ DEFR = LSAME( JOBR, 'N' )
+ L2PERT = LSAME( JOBP, 'P' )
+*
+ LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 )
+*
+ IF ( .NOT.(ROWPIV .OR. L2RANK .OR. L2ABER .OR.
+ $ ERREST .OR. LSAME( JOBA, 'C' ) )) THEN
+ INFO = - 1
+ ELSE IF ( .NOT.( LSVEC .OR. LSAME( JOBU, 'N' ) .OR.
+ $ ( LSAME( JOBU, 'W' ) .AND. RSVEC .AND. L2TRAN ) ) ) THEN
+ INFO = - 2
+ ELSE IF ( .NOT.( RSVEC .OR. LSAME( JOBV, 'N' ) .OR.
+ $ ( LSAME( JOBV, 'W' ) .AND. LSVEC .AND. L2TRAN ) ) ) THEN
+ INFO = - 3
+ ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN
+ INFO = - 4
+ ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. LSAME(JOBT,'N') ) ) THEN
+ INFO = - 5
+ ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN
+ INFO = - 6
+ ELSE IF ( M .LT. 0 ) THEN
+ INFO = - 7
+ ELSE IF ( ( N .LT. 0 ) .OR. ( N .GT. M ) ) THEN
+ INFO = - 8
+ ELSE IF ( LDA .LT. M ) THEN
+ INFO = - 10
+ ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN
+ INFO = - 13
+ ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN
+ INFO = - 15
+ ELSE
+* #:)
+ INFO = 0
+ END IF
+*
+ IF ( INFO .EQ. 0 ) THEN
+* .. compute the minimal and the optimal workspace lengths
+* [[The expressions for computing the minimal and the optimal
+* values of LCWORK, LRWORK are written with a lot of redundancy and
+* can be simplified. However, this verbose form is useful for
+* maintenance and modifications of the code.]]
+*
+* .. minimal workspace length for ZGEQP3 of an M x N matrix,
+* ZGEQRF of an N x N matrix, ZGELQF of an N x N matrix,
+* ZUNMLQ for computing N x N matrix, ZUNMQR for computing N x N
+* matrix, ZUNMQR for computing M x N matrix, respectively.
+ LWQP3 = N+1
+ LWQRF = MAX( 1, N )
+ LWLQF = MAX( 1, N )
+ LWUNMLQ = MAX( 1, N )
+ LWUNMQR = MAX( 1, N )
+ LWUNMQRM = MAX( 1, M )
+* .. minimal workspace length for ZPOCON of an N x N matrix
+ LWCON = 2 * N
+* .. minimal workspace length for ZGESVJ of an N x N matrix,
+* without and with explicit accumulation of Jacobi rotations
+ LWSVDJ = MAX( 2 * N, 1 )
+ LWSVDJV = MAX( 2 * N, 1 )
+* .. minimal REAL workspace length for ZGEQP3, ZPOCON, ZGESVJ
+ LRWQP3 = N
+ LRWCON = N
+ LRWSVDJ = N
+ IF ( LQUERY ) THEN
+ CALL ZGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1,
+ $ RDUMMY, IERR )
+ LWRK_ZGEQP3 = CDUMMY(1)
+ CALL ZGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
+ LWRK_ZGEQRF = CDUMMY(1)
+ CALL ZGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
+ LWRK_ZGELQF = CDUMMY(1)
+ END IF
+ MINWRK = 2
+ OPTWRK = 2
+ MINIWRK = N
+ IF ( .NOT. (LSVEC .OR. RSVEC ) ) THEN
+* .. minimal and optimal sizes of the complex workspace if
+* only the singular values are requested
+ IF ( ERREST ) THEN
+ MINWRK = MAX( N+LWQP3, N**2+LWCON, N+LWQRF, LWSVDJ )
+ ELSE
+ MINWRK = MAX( N+LWQP3, N+LWQRF, LWSVDJ )
+ END IF
+ IF ( LQUERY ) THEN
+ CALL ZGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V,
+ $ LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_ZGESVJ = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = MAX( N+LWRK_ZGEQP3, N**2+LWCON,
+ $ N+LWRK_ZGEQRF, LWRK_ZGESVJ )
+ ELSE
+ OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWRK_ZGEQRF,
+ $ LWRK_ZGESVJ )
+ END IF
+ END IF
+ IF ( L2TRAN .OR. ROWPIV ) THEN
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWCON, LRWSVDJ )
+ ELSE
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )
+ END IF
+ ELSE
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, LRWQP3, LRWCON, LRWSVDJ )
+ ELSE
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )
+ END IF
+ END IF
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN
+* .. minimal and optimal sizes of the complex workspace if the
+* singular values and the right singular vectors are requested
+ IF ( ERREST ) THEN
+ MINWRK = MAX( N+LWQP3, LWCON, LWSVDJ, N+LWLQF,
+ $ 2*N+LWQRF, N+LWSVDJ, N+LWUNMLQ )
+ ELSE
+ MINWRK = MAX( N+LWQP3, LWSVDJ, N+LWLQF, 2*N+LWQRF,
+ $ N+LWSVDJ, N+LWUNMLQ )
+ END IF
+ IF ( LQUERY ) THEN
+ CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
+ $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_ZGESVJ = CDUMMY(1)
+ CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
+ $ V, LDV, CDUMMY, -1, IERR )
+ LWRK_ZUNMLQ = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = MAX( N+LWRK_ZGEQP3, LWCON, LWRK_ZGESVJ,
+ $ N+LWRK_ZGELQF, 2*N+LWRK_ZGEQRF,
+ $ N+LWRK_ZGESVJ, N+LWRK_ZUNMLQ )
+ ELSE
+ OPTWRK = MAX( N+LWRK_ZGEQP3, LWRK_ZGESVJ,N+LWRK_ZGELQF,
+ $ 2*N+LWRK_ZGEQRF, N+LWRK_ZGESVJ,
+ $ N+LWRK_ZUNMLQ )
+ END IF
+ END IF
+ IF ( L2TRAN .OR. ROWPIV ) THEN
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )
+ END IF
+ ELSE
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )
+ END IF
+ END IF
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN
+* .. minimal and optimal sizes of the complex workspace if the
+* singular values and the left singular vectors are requested
+ IF ( ERREST ) THEN
+ MINWRK = N + MAX( LWQP3,LWCON,N+LWQRF,LWSVDJ,LWUNMQRM )
+ ELSE
+ MINWRK = N + MAX( LWQP3, N+LWQRF, LWSVDJ, LWUNMQRM )
+ END IF
+ IF ( LQUERY ) THEN
+ CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
+ $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_ZGESVJ = CDUMMY(1)
+ CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
+ $ LDU, CDUMMY, -1, IERR )
+ LWRK_ZUNMQRM = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = N + MAX( LWRK_ZGEQP3, LWCON, N+LWRK_ZGEQRF,
+ $ LWRK_ZGESVJ, LWRK_ZUNMQRM )
+ ELSE
+ OPTWRK = N + MAX( LWRK_ZGEQP3, N+LWRK_ZGEQRF,
+ $ LWRK_ZGESVJ, LWRK_ZUNMQRM )
+ END IF
+ END IF
+ IF ( L2TRAN .OR. ROWPIV ) THEN
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ )
+ END IF
+ ELSE
+ IF ( ERREST ) THEN
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ )
+ END IF
+ END IF
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ ELSE
+* .. minimal and optimal sizes of the complex workspace if the
+* full SVD is requested
+ IF ( .NOT. JRACC ) THEN
+ IF ( ERREST ) THEN
+ MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+N**2+LWCON,
+ $ 2*N+LWQRF, 2*N+LWQP3,
+ $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON,
+ $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV,
+ $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ,
+ $ N+N**2+LWSVDJ, N+LWUNMQRM )
+ ELSE
+ MINWRK = MAX( N+LWQP3, 2*N+N**2+LWCON,
+ $ 2*N+LWQRF, 2*N+LWQP3,
+ $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON,
+ $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV,
+ $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ,
+ $ N+N**2+LWSVDJ, N+LWUNMQRM )
+ END IF
+ MINIWRK = MINIWRK + N
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ ELSE
+ IF ( ERREST ) THEN
+ MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+LWQRF,
+ $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR,
+ $ N+LWUNMQRM )
+ ELSE
+ MINWRK = MAX( N+LWQP3, 2*N+LWQRF,
+ $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR,
+ $ N+LWUNMQRM )
+ END IF
+ IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M
+ END IF
+ IF ( LQUERY ) THEN
+ CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
+ $ LDU, CDUMMY, -1, IERR )
+ LWRK_ZUNMQRM = CDUMMY(1)
+ CALL ZUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U,
+ $ LDU, CDUMMY, -1, IERR )
+ LWRK_ZUNMQR = CDUMMY(1)
+ IF ( .NOT. JRACC ) THEN
+ CALL ZGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1,
+ $ RDUMMY, IERR )
+ LWRK_ZGEQP3N = CDUMMY(1)
+ CALL ZGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA,
+ $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_ZGESVJ = CDUMMY(1)
+ CALL ZGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA,
+ $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_ZGESVJU = CDUMMY(1)
+ CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
+ $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_ZGESVJV = CDUMMY(1)
+ CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
+ $ V, LDV, CDUMMY, -1, IERR )
+ LWRK_ZUNMLQ = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON,
+ $ 2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF,
+ $ 2*N+LWRK_ZGEQP3N,
+ $ 2*N+N**2+N+LWRK_ZGELQF,
+ $ 2*N+N**2+N+N**2+LWCON,
+ $ 2*N+N**2+N+LWRK_ZGESVJ,
+ $ 2*N+N**2+N+LWRK_ZGESVJV,
+ $ 2*N+N**2+N+LWRK_ZUNMQR,
+ $ 2*N+N**2+N+LWRK_ZUNMLQ,
+ $ N+N**2+LWRK_ZGESVJU,
+ $ N+LWRK_ZUNMQRM )
+ ELSE
+ OPTWRK = MAX( N+LWRK_ZGEQP3,
+ $ 2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF,
+ $ 2*N+LWRK_ZGEQP3N,
+ $ 2*N+N**2+N+LWRK_ZGELQF,
+ $ 2*N+N**2+N+N**2+LWCON,
+ $ 2*N+N**2+N+LWRK_ZGESVJ,
+ $ 2*N+N**2+N+LWRK_ZGESVJV,
+ $ 2*N+N**2+N+LWRK_ZUNMQR,
+ $ 2*N+N**2+N+LWRK_ZUNMLQ,
+ $ N+N**2+LWRK_ZGESVJU,
+ $ N+LWRK_ZUNMQRM )
+ END IF
+ ELSE
+ CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
+ $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
+ LWRK_ZGESVJV = CDUMMY(1)
+ CALL ZUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY,
+ $ V, LDV, CDUMMY, -1, IERR )
+ LWRK_ZUNMQR = CDUMMY(1)
+ CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
+ $ LDU, CDUMMY, -1, IERR )
+ LWRK_ZUNMQRM = CDUMMY(1)
+ IF ( ERREST ) THEN
+ OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON,
+ $ 2*N+LWRK_ZGEQRF, 2*N+N**2,
+ $ 2*N+N**2+LWRK_ZGESVJV,
+ $ 2*N+N**2+N+LWRK_ZUNMQR,N+LWRK_ZUNMQRM )
+ ELSE
+ OPTWRK = MAX( N+LWRK_ZGEQP3, 2*N+LWRK_ZGEQRF,
+ $ 2*N+N**2, 2*N+N**2+LWRK_ZGESVJV,
+ $ 2*N+N**2+N+LWRK_ZUNMQR,
+ $ N+LWRK_ZUNMQRM )
+ END IF
+ END IF
+ END IF
+ IF ( L2TRAN .OR. ROWPIV ) THEN
+ MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON )
+ ELSE
+ MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON )
+ END IF
+ END IF
+ MINWRK = MAX( 2, MINWRK )
+ OPTWRK = MAX( 2, OPTWRK )
+ IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = - 17
+ IF ( LRWORK .LT. MINRWRK .AND. (.NOT.LQUERY) ) INFO = - 19
+ END IF
+*
+ IF ( INFO .NE. 0 ) THEN
+* #:(
+ CALL XERBLA( 'ZGEJSV', - INFO )
+ RETURN
+ ELSE IF ( LQUERY ) THEN
+ CWORK(1) = OPTWRK
+ CWORK(2) = MINWRK
+ RWORK(1) = MINRWRK
+ IWORK(1) = MAX( 4, MINIWRK )
+ RETURN
+ END IF
+*
+* Quick return for void matrix (Y3K safe)
+* #:)
+ IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN
+ IWORK(1:4) = 0
+ RWORK(1:7) = 0
+ RETURN
+ ENDIF
+*
+* Determine whether the matrix U should be M x N or M x M
+*
+ IF ( LSVEC ) THEN
+ N1 = N
+ IF ( LSAME( JOBU, 'F' ) ) N1 = M
+ END IF
+*
+* Set numerical parameters
+*
+*! NOTE: Make sure DLAMCH() does not fail on the target architecture.
+*
+ EPSLN = DLAMCH('Epsilon')
+ SFMIN = DLAMCH('SafeMinimum')
+ SMALL = SFMIN / EPSLN
+ BIG = DLAMCH('O')
+* BIG = ONE / SFMIN
+*
+* Initialize SVA(1:N) = diag( ||A e_i||_2 )_1^N
+*
+*(!) If necessary, scale SVA() to protect the largest norm from
+* overflow. It is possible that this scaling pushes the smallest
+* column norm left from the underflow threshold (extreme case).
+*
+ SCALEM = ONE / SQRT(DBLE(M)*DBLE(N))
+ NOSCAL = .TRUE.
+ GOSCAL = .TRUE.
+ DO 1874 p = 1, N
+ AAPP = ZERO
+ AAQQ = ONE
+ CALL ZLASSQ( M, A(1,p), 1, AAPP, AAQQ )
+ IF ( AAPP .GT. BIG ) THEN
+ INFO = - 9
+ CALL XERBLA( 'ZGEJSV', -INFO )
+ RETURN
+ END IF
+ AAQQ = SQRT(AAQQ)
+ IF ( ( AAPP .LT. (BIG / AAQQ) ) .AND. NOSCAL ) THEN
+ SVA(p) = AAPP * AAQQ
+ ELSE
+ NOSCAL = .FALSE.
+ SVA(p) = AAPP * ( AAQQ * SCALEM )
+ IF ( GOSCAL ) THEN
+ GOSCAL = .FALSE.
+ CALL DSCAL( p-1, SCALEM, SVA, 1 )
+ END IF
+ END IF
+ 1874 CONTINUE
+*
+ IF ( NOSCAL ) SCALEM = ONE
+*
+ AAPP = ZERO
+ AAQQ = BIG
+ DO 4781 p = 1, N
+ AAPP = MAX( AAPP, SVA(p) )
+ IF ( SVA(p) .NE. ZERO ) AAQQ = MIN( AAQQ, SVA(p) )
+ 4781 CONTINUE
+*
+* Quick return for zero M x N matrix
+* #:)
+ IF ( AAPP .EQ. ZERO ) THEN
+ IF ( LSVEC ) CALL ZLASET( 'G', M, N1, CZERO, CONE, U, LDU )
+ IF ( RSVEC ) CALL ZLASET( 'G', N, N, CZERO, CONE, V, LDV )
+ RWORK(1) = ONE
+ RWORK(2) = ONE
+ IF ( ERREST ) RWORK(3) = ONE
+ IF ( LSVEC .AND. RSVEC ) THEN
+ RWORK(4) = ONE
+ RWORK(5) = ONE
+ END IF
+ IF ( L2TRAN ) THEN
+ RWORK(6) = ZERO
+ RWORK(7) = ZERO
+ END IF
+ IWORK(1) = 0
+ IWORK(2) = 0
+ IWORK(3) = 0
+ IWORK(4) = -1
+ RETURN
+ END IF
+*
+* Issue warning if denormalized column norms detected. Override the
+* high relative accuracy request. Issue licence to kill nonzero columns
+* (set them to zero) whose norm is less than sigma_max / BIG (roughly).
+* #:(
+ WARNING = 0
+ IF ( AAQQ .LE. SFMIN ) THEN
+ L2RANK = .TRUE.
+ L2KILL = .TRUE.
+ WARNING = 1
+ END IF
+*
+* Quick return for one-column matrix
+* #:)
+ IF ( N .EQ. 1 ) THEN
+*
+ IF ( LSVEC ) THEN
+ CALL ZLASCL( 'G',0,0,SVA(1),SCALEM, M,1,A(1,1),LDA,IERR )
+ CALL ZLACPY( 'A', M, 1, A, LDA, U, LDU )
+* computing all M left singular vectors of the M x 1 matrix
+ IF ( N1 .NE. N ) THEN
+ CALL ZGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N,IERR )
+ CALL ZUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N,IERR )
+ CALL ZCOPY( M, A(1,1), 1, U(1,1), 1 )
+ END IF
+ END IF
+ IF ( RSVEC ) THEN
+ V(1,1) = CONE
+ END IF
+ IF ( SVA(1) .LT. (BIG*SCALEM) ) THEN
+ SVA(1) = SVA(1) / SCALEM
+ SCALEM = ONE
+ END IF
+ RWORK(1) = ONE / SCALEM
+ RWORK(2) = ONE
+ IF ( SVA(1) .NE. ZERO ) THEN
+ IWORK(1) = 1
+ IF ( ( SVA(1) / SCALEM) .GE. SFMIN ) THEN
+ IWORK(2) = 1
+ ELSE
+ IWORK(2) = 0
+ END IF
+ ELSE
+ IWORK(1) = 0
+ IWORK(2) = 0
+ END IF
+ IWORK(3) = 0
+ IWORK(4) = -1
+ IF ( ERREST ) RWORK(3) = ONE
+ IF ( LSVEC .AND. RSVEC ) THEN
+ RWORK(4) = ONE
+ RWORK(5) = ONE
+ END IF
+ IF ( L2TRAN ) THEN
+ RWORK(6) = ZERO
+ RWORK(7) = ZERO
+ END IF
+ RETURN
+*
+ END IF
+*
+ TRANSP = .FALSE.
+*
+ AATMAX = -ONE
+ AATMIN = BIG
+ IF ( ROWPIV .OR. L2TRAN ) THEN
+*
+* Compute the row norms, needed to determine row pivoting sequence
+* (in the case of heavily row weighted A, row pivoting is strongly
+* advised) and to collect information needed to compare the
+* structures of A * A^* and A^* * A (in the case L2TRAN.EQ..TRUE.).
+*
+ IF ( L2TRAN ) THEN
+ DO 1950 p = 1, M
+ XSC = ZERO
+ TEMP1 = ONE
+ CALL ZLASSQ( N, A(p,1), LDA, XSC, TEMP1 )
+* ZLASSQ gets both the ell_2 and the ell_infinity norm
+* in one pass through the vector
+ RWORK(M+p) = XSC * SCALEM
+ RWORK(p) = XSC * (SCALEM*SQRT(TEMP1))
+ AATMAX = MAX( AATMAX, RWORK(p) )
+ IF (RWORK(p) .NE. ZERO)
+ $ AATMIN = MIN(AATMIN,RWORK(p))
+ 1950 CONTINUE
+ ELSE
+ DO 1904 p = 1, M
+ RWORK(M+p) = SCALEM*ABS( A(p,IZAMAX(N,A(p,1),LDA)) )
+ AATMAX = MAX( AATMAX, RWORK(M+p) )
+ AATMIN = MIN( AATMIN, RWORK(M+p) )
+ 1904 CONTINUE
+ END IF
+*
+ END IF
+*
+* For square matrix A try to determine whether A^* would be better
+* input for the preconditioned Jacobi SVD, with faster convergence.
+* The decision is based on an O(N) function of the vector of column
+* and row norms of A, based on the Shannon entropy. This should give
+* the right choice in most cases when the difference actually matters.
+* It may fail and pick the slower converging side.
+*
+ ENTRA = ZERO
+ ENTRAT = ZERO
+ IF ( L2TRAN ) THEN
+*
+ XSC = ZERO
+ TEMP1 = ONE
+ CALL DLASSQ( N, SVA, 1, XSC, TEMP1 )
+ TEMP1 = ONE / TEMP1
+*
+ ENTRA = ZERO
+ DO 1113 p = 1, N
+ BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1
+ IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * DLOG(BIG1)
+ 1113 CONTINUE
+ ENTRA = - ENTRA / DLOG(DBLE(N))
+*
+* Now, SVA().^2/Trace(A^* * A) is a point in the probability simplex.
+* It is derived from the diagonal of A^* * A. Do the same with the
+* diagonal of A * A^*, compute the entropy of the corresponding
+* probability distribution. Note that A * A^* and A^* * A have the
+* same trace.
+*
+ ENTRAT = ZERO
+ DO 1114 p = 1, M
+ BIG1 = ( ( RWORK(p) / XSC )**2 ) * TEMP1
+ IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * DLOG(BIG1)
+ 1114 CONTINUE
+ ENTRAT = - ENTRAT / DLOG(DBLE(M))
+*
+* Analyze the entropies and decide A or A^*. Smaller entropy
+* usually means better input for the algorithm.
+*
+ TRANSP = ( ENTRAT .LT. ENTRA )
+*
+* If A^* is better than A, take the adjoint of A. This is allowed
+* only for square matrices, M=N.
+ IF ( TRANSP ) THEN
+* In an optimal implementation, this trivial transpose
+* should be replaced with faster transpose.
+ DO 1115 p = 1, N - 1
+ A(p,p) = CONJG(A(p,p))
+ DO 1116 q = p + 1, N
+ CTEMP = CONJG(A(q,p))
+ A(q,p) = CONJG(A(p,q))
+ A(p,q) = CTEMP
+ 1116 CONTINUE
+ 1115 CONTINUE
+ A(N,N) = CONJG(A(N,N))
+ DO 1117 p = 1, N
+ RWORK(M+p) = SVA(p)
+ SVA(p) = RWORK(p)
+* previously computed row 2-norms are now column 2-norms
+* of the transposed matrix
+ 1117 CONTINUE
+ TEMP1 = AAPP
+ AAPP = AATMAX
+ AATMAX = TEMP1
+ TEMP1 = AAQQ
+ AAQQ = AATMIN
+ AATMIN = TEMP1
+ KILL = LSVEC
+ LSVEC = RSVEC
+ RSVEC = KILL
+ IF ( LSVEC ) N1 = N
+*
+ ROWPIV = .TRUE.
+ END IF
+*
+ END IF
+* END IF L2TRAN
+*
+* Scale the matrix so that its maximal singular value remains less
+* than SQRT(BIG) -- the matrix is scaled so that its maximal column
+* has Euclidean norm equal to SQRT(BIG/N). The only reason to keep
+* SQRT(BIG) instead of BIG is the fact that ZGEJSV uses LAPACK and
+* BLAS routines that, in some implementations, are not capable of
+* working in the full interval [SFMIN,BIG] and that they may provoke
+* overflows in the intermediate results. If the singular values spread
+* from SFMIN to BIG, then ZGESVJ will compute them. So, in that case,
+* one should use ZGESVJ instead of ZGEJSV.
+* >> change in the April 2016 update: allow bigger range, i.e. the
+* largest column is allowed up to BIG/N and ZGESVJ will do the rest.
+ BIG1 = SQRT( BIG )
+ TEMP1 = SQRT( BIG / DBLE(N) )
+* TEMP1 = BIG/DBLE(N)
+*
+ CALL DLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR )
+ IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN
+ AAQQ = ( AAQQ / AAPP ) * TEMP1
+ ELSE
+ AAQQ = ( AAQQ * TEMP1 ) / AAPP
+ END IF
+ TEMP1 = TEMP1 * SCALEM
+ CALL ZLASCL( 'G', 0, 0, AAPP, TEMP1, M, N, A, LDA, IERR )
+*
+* To undo scaling at the end of this procedure, multiply the
+* computed singular values with USCAL2 / USCAL1.
+*
+ USCAL1 = TEMP1
+ USCAL2 = AAPP
+*
+ IF ( L2KILL ) THEN
+* L2KILL enforces computation of nonzero singular values in
+* the restricted range of condition number of the initial A,
+* sigma_max(A) / sigma_min(A) approx. SQRT(BIG)/SQRT(SFMIN).
+ XSC = SQRT( SFMIN )
+ ELSE
+ XSC = SMALL
+*
+* Now, if the condition number of A is too big,
+* sigma_max(A) / sigma_min(A) .GT. SQRT(BIG/N) * EPSLN / SFMIN,
+* as a precaution measure, the full SVD is computed using ZGESVJ
+* with accumulated Jacobi rotations. This provides numerically
+* more robust computation, at the cost of slightly increased run
+* time. Depending on the concrete implementation of BLAS and LAPACK
+* (i.e. how they behave in presence of extreme ill-conditioning) the
+* implementor may decide to remove this switch.
+ IF ( ( AAQQ.LT.SQRT(SFMIN) ) .AND. LSVEC .AND. RSVEC ) THEN
+ JRACC = .TRUE.
+ END IF
+*
+ END IF
+ IF ( AAQQ .LT. XSC ) THEN
+ DO 700 p = 1, N
+ IF ( SVA(p) .LT. XSC ) THEN
+ CALL ZLASET( 'A', M, 1, CZERO, CZERO, A(1,p), LDA )
+ SVA(p) = ZERO
+ END IF
+ 700 CONTINUE
+ END IF
+*
+* Preconditioning using QR factorization with pivoting
+*
+ IF ( ROWPIV ) THEN
+* Optional row permutation (Bjoerck row pivoting):
+* A result by Cox and Higham shows that the Bjoerck's
+* row pivoting combined with standard column pivoting
+* has similar effect as Powell-Reid complete pivoting.
+* The ell-infinity norms of A are made nonincreasing.
+ IF ( ( LSVEC .AND. RSVEC ) .AND. .NOT.( JRACC ) ) THEN
+ IWOFF = 2*N
+ ELSE
+ IWOFF = N
+ END IF
+ DO 1952 p = 1, M - 1
+ q = IDAMAX( M-p+1, RWORK(M+p), 1 ) + p - 1
+ IWORK(IWOFF+p) = q
+ IF ( p .NE. q ) THEN
+ TEMP1 = RWORK(M+p)
+ RWORK(M+p) = RWORK(M+q)
+ RWORK(M+q) = TEMP1
+ END IF
+ 1952 CONTINUE
+ CALL ZLASWP( N, A, LDA, 1, M-1, IWORK(IWOFF+1), 1 )
+ END IF
+*
+* End of the preparation phase (scaling, optional sorting and
+* transposing, optional flushing of small columns).
+*
+* Preconditioning
+*
+* If the full SVD is needed, the right singular vectors are computed
+* from a matrix equation, and for that we need theoretical analysis
+* of the Businger-Golub pivoting. So we use ZGEQP3 as the first RR QRF.
+* In all other cases the first RR QRF can be chosen by other criteria
+* (eg speed by replacing global with restricted window pivoting, such
+* as in xGEQPX from TOMS # 782). Good results will be obtained using
+* xGEQPX with properly (!) chosen numerical parameters.
+* Any improvement of ZGEQP3 improves overal performance of ZGEJSV.
+*
+* A * P1 = Q1 * [ R1^* 0]^*:
+ DO 1963 p = 1, N
+* .. all columns are free columns
+ IWORK(p) = 0
+ 1963 CONTINUE
+ CALL ZGEQP3( M, N, A, LDA, IWORK, CWORK, CWORK(N+1), LWORK-N,
+ $ RWORK, IERR )
+*
+* The upper triangular matrix R1 from the first QRF is inspected for
+* rank deficiency and possibilities for deflation, or possible
+* ill-conditioning. Depending on the user specified flag L2RANK,
+* the procedure explores possibilities to reduce the numerical
+* rank by inspecting the computed upper triangular factor. If
+* L2RANK or L2ABER are up, then ZGEJSV will compute the SVD of
+* A + dA, where ||dA|| <= f(M,N)*EPSLN.
+*
+ NR = 1
+ IF ( L2ABER ) THEN
+* Standard absolute error bound suffices. All sigma_i with
+* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an
+* agressive enforcement of lower numerical rank by introducing a
+* backward error of the order of N*EPSLN*||A||.
+ TEMP1 = SQRT(DBLE(N))*EPSLN
+ DO 3001 p = 2, N
+ IF ( ABS(A(p,p)) .GE. (TEMP1*ABS(A(1,1))) ) THEN
+ NR = NR + 1
+ ELSE
+ GO TO 3002
+ END IF
+ 3001 CONTINUE
+ 3002 CONTINUE
+ ELSE IF ( L2RANK ) THEN
+* .. similarly as above, only slightly more gentle (less agressive).
+* Sudden drop on the diagonal of R1 is used as the criterion for
+* close-to-rank-deficient.
+ TEMP1 = SQRT(SFMIN)
+ DO 3401 p = 2, N
+ IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR.
+ $ ( ABS(A(p,p)) .LT. SMALL ) .OR.
+ $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3402
+ NR = NR + 1
+ 3401 CONTINUE
+ 3402 CONTINUE
+*
+ ELSE
+* The goal is high relative accuracy. However, if the matrix
+* has high scaled condition number the relative accuracy is in
+* general not feasible. Later on, a condition number estimator
+* will be deployed to estimate the scaled condition number.
+* Here we just remove the underflowed part of the triangular
+* factor. This prevents the situation in which the code is
+* working hard to get the accuracy not warranted by the data.
+ TEMP1 = SQRT(SFMIN)
+ DO 3301 p = 2, N
+ IF ( ( ABS(A(p,p)) .LT. SMALL ) .OR.
+ $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3302
+ NR = NR + 1
+ 3301 CONTINUE
+ 3302 CONTINUE
+*
+ END IF
+*
+ ALMORT = .FALSE.
+ IF ( NR .EQ. N ) THEN
+ MAXPRJ = ONE
+ DO 3051 p = 2, N
+ TEMP1 = ABS(A(p,p)) / SVA(IWORK(p))
+ MAXPRJ = MIN( MAXPRJ, TEMP1 )
+ 3051 CONTINUE
+ IF ( MAXPRJ**2 .GE. ONE - DBLE(N)*EPSLN ) ALMORT = .TRUE.
+ END IF
+*
+*
+ SCONDA = - ONE
+ CONDR1 = - ONE
+ CONDR2 = - ONE
+*
+ IF ( ERREST ) THEN
+ IF ( N .EQ. NR ) THEN
+ IF ( RSVEC ) THEN
+* .. V is available as workspace
+ CALL ZLACPY( 'U', N, N, A, LDA, V, LDV )
+ DO 3053 p = 1, N
+ TEMP1 = SVA(IWORK(p))
+ CALL ZDSCAL( p, ONE/TEMP1, V(1,p), 1 )
+ 3053 CONTINUE
+ IF ( LSVEC )THEN
+ CALL ZPOCON( 'U', N, V, LDV, ONE, TEMP1,
+ $ CWORK(N+1), RWORK, IERR )
+ ELSE
+ CALL ZPOCON( 'U', N, V, LDV, ONE, TEMP1,
+ $ CWORK, RWORK, IERR )
+ END IF
+*
+ ELSE IF ( LSVEC ) THEN
+* .. U is available as workspace
+ CALL ZLACPY( 'U', N, N, A, LDA, U, LDU )
+ DO 3054 p = 1, N
+ TEMP1 = SVA(IWORK(p))
+ CALL ZDSCAL( p, ONE/TEMP1, U(1,p), 1 )
+ 3054 CONTINUE
+ CALL ZPOCON( 'U', N, U, LDU, ONE, TEMP1,
+ $ CWORK(N+1), RWORK, IERR )
+ ELSE
+ CALL ZLACPY( 'U', N, N, A, LDA, CWORK, N )
+*[] CALL ZLACPY( 'U', N, N, A, LDA, CWORK(N+1), N )
+* Change: here index shifted by N to the left, CWORK(1:N)
+* not needed for SIGMA only computation
+ DO 3052 p = 1, N
+ TEMP1 = SVA(IWORK(p))
+*[] CALL ZDSCAL( p, ONE/TEMP1, CWORK(N+(p-1)*N+1), 1 )
+ CALL ZDSCAL( p, ONE/TEMP1, CWORK((p-1)*N+1), 1 )
+ 3052 CONTINUE
+* .. the columns of R are scaled to have unit Euclidean lengths.
+*[] CALL ZPOCON( 'U', N, CWORK(N+1), N, ONE, TEMP1,
+*[] $ CWORK(N+N*N+1), RWORK, IERR )
+ CALL ZPOCON( 'U', N, CWORK, N, ONE, TEMP1,
+ $ CWORK(N*N+1), RWORK, IERR )
+*
+ END IF
+ IF ( TEMP1 .NE. ZERO ) THEN
+ SCONDA = ONE / SQRT(TEMP1)
+ ELSE
+ SCONDA = - ONE
+ END IF
+* SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1).
+* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA
+ ELSE
+ SCONDA = - ONE
+ END IF
+ END IF
+*
+ L2PERT = L2PERT .AND. ( ABS( A(1,1)/A(NR,NR) ) .GT. SQRT(BIG1) )
+* If there is no violent scaling, artificial perturbation is not needed.
+*
+* Phase 3:
+*
+ IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN
+*
+* Singular Values only
+*
+* .. transpose A(1:NR,1:N)
+ DO 1946 p = 1, MIN( N-1, NR )
+ CALL ZCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 )
+ CALL ZLACGV( N-p+1, A(p,p), 1 )
+ 1946 CONTINUE
+ IF ( NR .EQ. N ) A(N,N) = CONJG(A(N,N))
+*
+* The following two DO-loops introduce small relative perturbation
+* into the strict upper triangle of the lower triangular matrix.
+* Small entries below the main diagonal are also changed.
+* This modification is useful if the computing environment does not
+* provide/allow FLUSH TO ZERO underflow, for it prevents many
+* annoying denormalized numbers in case of strongly scaled matrices.
+* The perturbation is structured so that it does not introduce any
+* new perturbation of the singular values, and it does not destroy
+* the job done by the preconditioner.
+* The licence for this perturbation is in the variable L2PERT, which
+* should be .FALSE. if FLUSH TO ZERO underflow is active.
+*
+ IF ( .NOT. ALMORT ) THEN
+*
+ IF ( L2PERT ) THEN
+* XSC = SQRT(SMALL)
+ XSC = EPSLN / DBLE(N)
+ DO 4947 q = 1, NR
+ CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO)
+ DO 4949 p = 1, N
+ IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )
+ $ .OR. ( p .LT. q ) )
+* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) )
+ $ A(p,q) = CTEMP
+ 4949 CONTINUE
+ 4947 CONTINUE
+ ELSE
+ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, A(1,2),LDA )
+ END IF
+*
+* .. second preconditioning using the QR factorization
+*
+ CALL ZGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, IERR )
+*
+* .. and transpose upper to lower triangular
+ DO 1948 p = 1, NR - 1
+ CALL ZCOPY( NR-p, A(p,p+1), LDA, A(p+1,p), 1 )
+ CALL ZLACGV( NR-p+1, A(p,p), 1 )
+ 1948 CONTINUE
+*
+ END IF
+*
+* Row-cyclic Jacobi SVD algorithm with column pivoting
+*
+* .. again some perturbation (a "background noise") is added
+* to drown denormals
+ IF ( L2PERT ) THEN
+* XSC = SQRT(SMALL)
+ XSC = EPSLN / DBLE(N)
+ DO 1947 q = 1, NR
+ CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO)
+ DO 1949 p = 1, NR
+ IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) )
+ $ .OR. ( p .LT. q ) )
+* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) )
+ $ A(p,q) = CTEMP
+ 1949 CONTINUE
+ 1947 CONTINUE
+ ELSE
+ CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), LDA )
+ END IF
+*
+* .. and one-sided Jacobi rotations are started on a lower
+* triangular matrix (plus perturbation which is ignored in
+* the part which destroys triangular form (confusing?!))
+*
+ CALL ZGESVJ( 'L', 'N', 'N', NR, NR, A, LDA, SVA,
+ $ N, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO )
+*
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+*
+*
+ ELSE IF ( ( RSVEC .AND. ( .NOT. LSVEC ) .AND. ( .NOT. JRACC ) )
+ $ .OR.
+ $ ( JRACC .AND. ( .NOT. LSVEC ) .AND. ( NR .NE. N ) ) ) THEN
+*
+* -> Singular Values and Right Singular Vectors <-
+*
+ IF ( ALMORT ) THEN
+*
+* .. in this case NR equals N
+ DO 1998 p = 1, NR
+ CALL ZCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
+ CALL ZLACGV( N-p+1, V(p,p), 1 )
+ 1998 CONTINUE
+ CALL ZLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV )
+*
+ CALL ZGESVJ( 'L','U','N', N, NR, V, LDV, SVA, NR, A, LDA,
+ $ CWORK, LWORK, RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+
+ ELSE
+*
+* .. two more QR factorizations ( one QRF is not enough, two require
+* accumulated product of Jacobi rotations, three are perfect )
+*
+ CALL ZLASET( 'L', NR-1,NR-1, CZERO, CZERO, A(2,1), LDA )
+ CALL ZGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, IERR)
+ CALL ZLACPY( 'L', NR, NR, A, LDA, V, LDV )
+ CALL ZLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV )
+ CALL ZGEQRF( NR, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),
+ $ LWORK-2*N, IERR )
+ DO 8998 p = 1, NR
+ CALL ZCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 )
+ CALL ZLACGV( NR-p+1, V(p,p), 1 )
+ 8998 CONTINUE
+ CALL ZLASET('U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV)
+*
+ CALL ZGESVJ( 'L', 'U','N', NR, NR, V,LDV, SVA, NR, U,
+ $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ IF ( NR .LT. N ) THEN
+ CALL ZLASET( 'A',N-NR, NR, CZERO,CZERO, V(NR+1,1), LDV )
+ CALL ZLASET( 'A',NR, N-NR, CZERO,CZERO, V(1,NR+1), LDV )
+ CALL ZLASET( 'A',N-NR,N-NR,CZERO,CONE, V(NR+1,NR+1),LDV )
+ END IF
+*
+ CALL ZUNMLQ( 'L', 'C', N, N, NR, A, LDA, CWORK,
+ $ V, LDV, CWORK(N+1), LWORK-N, IERR )
+*
+ END IF
+* .. permute the rows of V
+* DO 8991 p = 1, N
+* CALL ZCOPY( N, V(p,1), LDV, A(IWORK(p),1), LDA )
+* 8991 CONTINUE
+* CALL ZLACPY( 'All', N, N, A, LDA, V, LDV )
+ CALL ZLAPMR( .FALSE., N, N, V, LDV, IWORK )
+*
+ IF ( TRANSP ) THEN
+ CALL ZLACPY( 'A', N, N, V, LDV, U, LDU )
+ END IF
+*
+ ELSE IF ( JRACC .AND. (.NOT. LSVEC) .AND. ( NR.EQ. N ) ) THEN
+*
+ CALL ZLASET( 'L', N-1,N-1, CZERO, CZERO, A(2,1), LDA )
+*
+ CALL ZGESVJ( 'U','N','V', N, N, A, LDA, SVA, N, V, LDV,
+ $ CWORK, LWORK, RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ CALL ZLAPMR( .FALSE., N, N, V, LDV, IWORK )
+*
+ ELSE IF ( LSVEC .AND. ( .NOT. RSVEC ) ) THEN
+*
+* .. Singular Values and Left Singular Vectors ..
+*
+* .. second preconditioning step to avoid need to accumulate
+* Jacobi rotations in the Jacobi iterations.
+ DO 1965 p = 1, NR
+ CALL ZCOPY( N-p+1, A(p,p), LDA, U(p,p), 1 )
+ CALL ZLACGV( N-p+1, U(p,p), 1 )
+ 1965 CONTINUE
+ CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )
+*
+ CALL ZGEQRF( N, NR, U, LDU, CWORK(N+1), CWORK(2*N+1),
+ $ LWORK-2*N, IERR )
+*
+ DO 1967 p = 1, NR - 1
+ CALL ZCOPY( NR-p, U(p,p+1), LDU, U(p+1,p), 1 )
+ CALL ZLACGV( N-p+1, U(p,p), 1 )
+ 1967 CONTINUE
+ CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )
+*
+ CALL ZGESVJ( 'L', 'U', 'N', NR,NR, U, LDU, SVA, NR, A,
+ $ LDA, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+*
+ IF ( NR .LT. M ) THEN
+ CALL ZLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), LDU )
+ IF ( NR .LT. N1 ) THEN
+ CALL ZLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU )
+ CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1),LDU )
+ END IF
+ END IF
+*
+ CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,
+ $ LDU, CWORK(N+1), LWORK-N, IERR )
+*
+ IF ( ROWPIV )
+ $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )
+*
+ DO 1974 p = 1, N1
+ XSC = ONE / DZNRM2( M, U(1,p), 1 )
+ CALL ZDSCAL( M, XSC, U(1,p), 1 )
+ 1974 CONTINUE
+*
+ IF ( TRANSP ) THEN
+ CALL ZLACPY( 'A', N, N, U, LDU, V, LDV )
+ END IF
+*
+ ELSE
+*
+* .. Full SVD ..
+*
+ IF ( .NOT. JRACC ) THEN
+*
+ IF ( .NOT. ALMORT ) THEN
+*
+* Second Preconditioning Step (QRF [with pivoting])
+* Note that the composition of TRANSPOSE, QRF and TRANSPOSE is
+* equivalent to an LQF CALL. Since in many libraries the QRF
+* seems to be better optimized than the LQF, we do explicit
+* transpose and use the QRF. This is subject to changes in an
+* optimized implementation of ZGEJSV.
+*
+ DO 1968 p = 1, NR
+ CALL ZCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
+ CALL ZLACGV( N-p+1, V(p,p), 1 )
+ 1968 CONTINUE
+*
+* .. the following two loops perturb small entries to avoid
+* denormals in the second QR factorization, where they are
+* as good as zeros. This is done to avoid painfully slow
+* computation with denormals. The relative size of the perturbation
+* is a parameter that can be changed by the implementer.
+* This perturbation device will be obsolete on machines with
+* properly implemented arithmetic.
+* To switch it off, set L2PERT=.FALSE. To remove it from the
+* code, remove the action under L2PERT=.TRUE., leave the ELSE part.
+* The following two loops should be blocked and fused with the
+* transposed copy above.
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 2969 q = 1, NR
+ CTEMP = DCMPLX(XSC*ABS( V(q,q) ),ZERO)
+ DO 2968 p = 1, N
+ IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )
+ $ .OR. ( p .LT. q ) )
+* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) )
+ $ V(p,q) = CTEMP
+ IF ( p .LT. q ) V(p,q) = - V(p,q)
+ 2968 CONTINUE
+ 2969 CONTINUE
+ ELSE
+ CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV )
+ END IF
+*
+* Estimate the row scaled condition number of R1
+* (If R1 is rectangular, N > NR, then the condition number
+* of the leading NR x NR submatrix is estimated.)
+*
+ CALL ZLACPY( 'L', NR, NR, V, LDV, CWORK(2*N+1), NR )
+ DO 3950 p = 1, NR
+ TEMP1 = DZNRM2(NR-p+1,CWORK(2*N+(p-1)*NR+p),1)
+ CALL ZDSCAL(NR-p+1,ONE/TEMP1,CWORK(2*N+(p-1)*NR+p),1)
+ 3950 CONTINUE
+ CALL ZPOCON('L',NR,CWORK(2*N+1),NR,ONE,TEMP1,
+ $ CWORK(2*N+NR*NR+1),RWORK,IERR)
+ CONDR1 = ONE / SQRT(TEMP1)
+* .. here need a second oppinion on the condition number
+* .. then assume worst case scenario
+* R1 is OK for inverse <=> CONDR1 .LT. DBLE(N)
+* more conservative <=> CONDR1 .LT. SQRT(DBLE(N))
+*
+ COND_OK = SQRT(SQRT(DBLE(NR)))
+*[TP] COND_OK is a tuning parameter.
+*
+ IF ( CONDR1 .LT. COND_OK ) THEN
+* .. the second QRF without pivoting. Note: in an optimized
+* implementation, this QRF should be implemented as the QRF
+* of a lower triangular matrix.
+* R1^* = Q2 * R2
+ CALL ZGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),
+ $ LWORK-2*N, IERR )
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)/EPSLN
+ DO 3959 p = 2, NR
+ DO 3958 q = 1, p - 1
+ CTEMP=DCMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),
+ $ ZERO)
+ IF ( ABS(V(q,p)) .LE. TEMP1 )
+* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) )
+ $ V(q,p) = CTEMP
+ 3958 CONTINUE
+ 3959 CONTINUE
+ END IF
+*
+ IF ( NR .NE. N )
+ $ CALL ZLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N )
+* .. save ...
+*
+* .. this transposed copy should be better than naive
+ DO 1969 p = 1, NR - 1
+ CALL ZCOPY( NR-p, V(p,p+1), LDV, V(p+1,p), 1 )
+ CALL ZLACGV(NR-p+1, V(p,p), 1 )
+ 1969 CONTINUE
+ V(NR,NR)=CONJG(V(NR,NR))
+*
+ CONDR2 = CONDR1
+*
+ ELSE
+*
+* .. ill-conditioned case: second QRF with pivoting
+* Note that windowed pivoting would be equaly good
+* numerically, and more run-time efficient. So, in
+* an optimal implementation, the next call to ZGEQP3
+* should be replaced with eg. CALL ZGEQPX (ACM TOMS #782)
+* with properly (carefully) chosen parameters.
+*
+* R1^* * P2 = Q2 * R2
+ DO 3003 p = 1, NR
+ IWORK(N+p) = 0
+ 3003 CONTINUE
+ CALL ZGEQP3( N, NR, V, LDV, IWORK(N+1), CWORK(N+1),
+ $ CWORK(2*N+1), LWORK-2*N, RWORK, IERR )
+** CALL ZGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),
+** $ LWORK-2*N, IERR )
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 3969 p = 2, NR
+ DO 3968 q = 1, p - 1
+ CTEMP=DCMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),
+ $ ZERO)
+ IF ( ABS(V(q,p)) .LE. TEMP1 )
+* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) )
+ $ V(q,p) = CTEMP
+ 3968 CONTINUE
+ 3969 CONTINUE
+ END IF
+*
+ CALL ZLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N )
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 8970 p = 2, NR
+ DO 8971 q = 1, p - 1
+ CTEMP=DCMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))),
+ $ ZERO)
+* V(p,q) = - TEMP1*( V(q,p) / ABS(V(q,p)) )
+ V(p,q) = - CTEMP
+ 8971 CONTINUE
+ 8970 CONTINUE
+ ELSE
+ CALL ZLASET( 'L',NR-1,NR-1,CZERO,CZERO,V(2,1),LDV )
+ END IF
+* Now, compute R2 = L3 * Q3, the LQ factorization.
+ CALL ZGELQF( NR, NR, V, LDV, CWORK(2*N+N*NR+1),
+ $ CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, IERR )
+* .. and estimate the condition number
+ CALL ZLACPY( 'L',NR,NR,V,LDV,CWORK(2*N+N*NR+NR+1),NR )
+ DO 4950 p = 1, NR
+ TEMP1 = DZNRM2( p, CWORK(2*N+N*NR+NR+p), NR )
+ CALL ZDSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), NR )
+ 4950 CONTINUE
+ CALL ZPOCON( 'L',NR,CWORK(2*N+N*NR+NR+1),NR,ONE,TEMP1,
+ $ CWORK(2*N+N*NR+NR+NR*NR+1),RWORK,IERR )
+ CONDR2 = ONE / SQRT(TEMP1)
+*
+*
+ IF ( CONDR2 .GE. COND_OK ) THEN
+* .. save the Householder vectors used for Q3
+* (this overwrittes the copy of R2, as it will not be
+* needed in this branch, but it does not overwritte the
+* Huseholder vectors of Q2.).
+ CALL ZLACPY( 'U', NR, NR, V, LDV, CWORK(2*N+1), N )
+* .. and the rest of the information on Q3 is in
+* WORK(2*N+N*NR+1:2*N+N*NR+N)
+ END IF
+*
+ END IF
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 4968 q = 2, NR
+ CTEMP = XSC * V(q,q)
+ DO 4969 p = 1, q - 1
+* V(p,q) = - TEMP1*( V(p,q) / ABS(V(p,q)) )
+ V(p,q) = - CTEMP
+ 4969 CONTINUE
+ 4968 CONTINUE
+ ELSE
+ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV )
+ END IF
+*
+* Second preconditioning finished; continue with Jacobi SVD
+* The input matrix is lower trinagular.
+*
+* Recover the right singular vectors as solution of a well
+* conditioned triangular matrix equation.
+*
+ IF ( CONDR1 .LT. COND_OK ) THEN
+*
+ CALL ZGESVJ( 'L','U','N',NR,NR,V,LDV,SVA,NR,U, LDU,
+ $ CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,RWORK,
+ $ LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ DO 3970 p = 1, NR
+ CALL ZCOPY( NR, V(1,p), 1, U(1,p), 1 )
+ CALL ZDSCAL( NR, SVA(p), V(1,p), 1 )
+ 3970 CONTINUE
+
+* .. pick the right matrix equation and solve it
+*
+ IF ( NR .EQ. N ) THEN
+* :)) .. best case, R1 is inverted. The solution of this matrix
+* equation is Q2*V2 = the product of the Jacobi rotations
+* used in ZGESVJ, premultiplied with the orthogonal matrix
+* from the second QR factorization.
+ CALL ZTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V,LDV)
+ ELSE
+* .. R1 is well conditioned, but non-square. Adjoint of R2
+* is inverted to get the product of the Jacobi rotations
+* used in ZGESVJ. The Q-factor from the second QR
+* factorization is then built in explicitly.
+ CALL ZTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1),
+ $ N,V,LDV)
+ IF ( NR .LT. N ) THEN
+ CALL ZLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV)
+ CALL ZLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV)
+ CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)
+ END IF
+ CALL ZUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),
+ $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR)
+ END IF
+*
+ ELSE IF ( CONDR2 .LT. COND_OK ) THEN
+*
+* The matrix R2 is inverted. The solution of the matrix equation
+* is Q3^* * V3 = the product of the Jacobi rotations (appplied to
+* the lower triangular L3 from the LQ factorization of
+* R2=L3*Q3), pre-multiplied with the transposed Q3.
+ CALL ZGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U,
+ $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR,
+ $ RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ DO 3870 p = 1, NR
+ CALL ZCOPY( NR, V(1,p), 1, U(1,p), 1 )
+ CALL ZDSCAL( NR, SVA(p), U(1,p), 1 )
+ 3870 CONTINUE
+ CALL ZTRSM('L','U','N','N',NR,NR,CONE,CWORK(2*N+1),N,
+ $ U,LDU)
+* .. apply the permutation from the second QR factorization
+ DO 873 q = 1, NR
+ DO 872 p = 1, NR
+ CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)
+ 872 CONTINUE
+ DO 874 p = 1, NR
+ U(p,q) = CWORK(2*N+N*NR+NR+p)
+ 874 CONTINUE
+ 873 CONTINUE
+ IF ( NR .LT. N ) THEN
+ CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )
+ CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )
+ CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)
+ END IF
+ CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),
+ $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
+ ELSE
+* Last line of defense.
+* #:( This is a rather pathological case: no scaled condition
+* improvement after two pivoted QR factorizations. Other
+* possibility is that the rank revealing QR factorization
+* or the condition estimator has failed, or the COND_OK
+* is set very close to ONE (which is unnecessary). Normally,
+* this branch should never be executed, but in rare cases of
+* failure of the RRQR or condition estimator, the last line of
+* defense ensures that ZGEJSV completes the task.
+* Compute the full SVD of L3 using ZGESVJ with explicit
+* accumulation of Jacobi rotations.
+ CALL ZGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U,
+ $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR,
+ $ RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ IF ( NR .LT. N ) THEN
+ CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )
+ CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )
+ CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV)
+ END IF
+ CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),
+ $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
+*
+ CALL ZUNMLQ( 'L', 'C', NR, NR, NR, CWORK(2*N+1), N,
+ $ CWORK(2*N+N*NR+1), U, LDU, CWORK(2*N+N*NR+NR+1),
+ $ LWORK-2*N-N*NR-NR, IERR )
+ DO 773 q = 1, NR
+ DO 772 p = 1, NR
+ CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q)
+ 772 CONTINUE
+ DO 774 p = 1, NR
+ U(p,q) = CWORK(2*N+N*NR+NR+p)
+ 774 CONTINUE
+ 773 CONTINUE
+*
+ END IF
+*
+* Permute the rows of V using the (column) permutation from the
+* first QRF. Also, scale the columns to make them unit in
+* Euclidean norm. This applies to all cases.
+*
+ TEMP1 = SQRT(DBLE(N)) * EPSLN
+ DO 1972 q = 1, N
+ DO 972 p = 1, N
+ CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)
+ 972 CONTINUE
+ DO 973 p = 1, N
+ V(p,q) = CWORK(2*N+N*NR+NR+p)
+ 973 CONTINUE
+ XSC = ONE / DZNRM2( N, V(1,q), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL ZDSCAL( N, XSC, V(1,q), 1 )
+ 1972 CONTINUE
+* At this moment, V contains the right singular vectors of A.
+* Next, assemble the left singular vector matrix U (M x N).
+ IF ( NR .LT. M ) THEN
+ CALL ZLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU)
+ IF ( NR .LT. N1 ) THEN
+ CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU)
+ CALL ZLASET('A',M-NR,N1-NR,CZERO,CONE,
+ $ U(NR+1,NR+1),LDU)
+ END IF
+ END IF
+*
+* The Q matrix from the first QRF is built into the left singular
+* matrix U. This applies to all cases.
+*
+ CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,
+ $ LDU, CWORK(N+1), LWORK-N, IERR )
+
+* The columns of U are normalized. The cost is O(M*N) flops.
+ TEMP1 = SQRT(DBLE(M)) * EPSLN
+ DO 1973 p = 1, NR
+ XSC = ONE / DZNRM2( M, U(1,p), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL ZDSCAL( M, XSC, U(1,p), 1 )
+ 1973 CONTINUE
+*
+* If the initial QRF is computed with row pivoting, the left
+* singular vectors must be adjusted.
+*
+ IF ( ROWPIV )
+ $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )
+*
+ ELSE
+*
+* .. the initial matrix A has almost orthogonal columns and
+* the second QRF is not needed
+*
+ CALL ZLACPY( 'U', N, N, A, LDA, CWORK(N+1), N )
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL)
+ DO 5970 p = 2, N
+ CTEMP = XSC * CWORK( N + (p-1)*N + p )
+ DO 5971 q = 1, p - 1
+* CWORK(N+(q-1)*N+p)=-TEMP1 * ( CWORK(N+(p-1)*N+q) /
+* $ ABS(CWORK(N+(p-1)*N+q)) )
+ CWORK(N+(q-1)*N+p)=-CTEMP
+ 5971 CONTINUE
+ 5970 CONTINUE
+ ELSE
+ CALL ZLASET( 'L',N-1,N-1,CZERO,CZERO,CWORK(N+2),N )
+ END IF
+*
+ CALL ZGESVJ( 'U', 'U', 'N', N, N, CWORK(N+1), N, SVA,
+ $ N, U, LDU, CWORK(N+N*N+1), LWORK-N-N*N, RWORK, LRWORK,
+ $ INFO )
+*
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+ DO 6970 p = 1, N
+ CALL ZCOPY( N, CWORK(N+(p-1)*N+1), 1, U(1,p), 1 )
+ CALL ZDSCAL( N, SVA(p), CWORK(N+(p-1)*N+1), 1 )
+ 6970 CONTINUE
+*
+ CALL ZTRSM( 'L', 'U', 'N', 'N', N, N,
+ $ CONE, A, LDA, CWORK(N+1), N )
+ DO 6972 p = 1, N
+ CALL ZCOPY( N, CWORK(N+p), N, V(IWORK(p),1), LDV )
+ 6972 CONTINUE
+ TEMP1 = SQRT(DBLE(N))*EPSLN
+ DO 6971 p = 1, N
+ XSC = ONE / DZNRM2( N, V(1,p), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL ZDSCAL( N, XSC, V(1,p), 1 )
+ 6971 CONTINUE
+*
+* Assemble the left singular vector matrix U (M x N).
+*
+ IF ( N .LT. M ) THEN
+ CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), LDU )
+ IF ( N .LT. N1 ) THEN
+ CALL ZLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1),LDU)
+ CALL ZLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1),LDU)
+ END IF
+ END IF
+ CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,
+ $ LDU, CWORK(N+1), LWORK-N, IERR )
+ TEMP1 = SQRT(DBLE(M))*EPSLN
+ DO 6973 p = 1, N1
+ XSC = ONE / DZNRM2( M, U(1,p), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL ZDSCAL( M, XSC, U(1,p), 1 )
+ 6973 CONTINUE
+*
+ IF ( ROWPIV )
+ $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )
+*
+ END IF
+*
+* end of the >> almost orthogonal case << in the full SVD
+*
+ ELSE
+*
+* This branch deploys a preconditioned Jacobi SVD with explicitly
+* accumulated rotations. It is included as optional, mainly for
+* experimental purposes. It does perfom well, and can also be used.
+* In this implementation, this branch will be automatically activated
+* if the condition number sigma_max(A) / sigma_min(A) is predicted
+* to be greater than the overflow threshold. This is because the
+* a posteriori computation of the singular vectors assumes robust
+* implementation of BLAS and some LAPACK procedures, capable of working
+* in presence of extreme values, e.g. when the singular values spread from
+* the underflow to the overflow threshold.
+*
+ DO 7968 p = 1, NR
+ CALL ZCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 )
+ CALL ZLACGV( N-p+1, V(p,p), 1 )
+ 7968 CONTINUE
+*
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL/EPSLN)
+ DO 5969 q = 1, NR
+ CTEMP = DCMPLX(XSC*ABS( V(q,q) ),ZERO)
+ DO 5968 p = 1, N
+ IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 )
+ $ .OR. ( p .LT. q ) )
+* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) )
+ $ V(p,q) = CTEMP
+ IF ( p .LT. q ) V(p,q) = - V(p,q)
+ 5968 CONTINUE
+ 5969 CONTINUE
+ ELSE
+ CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV )
+ END IF
+
+ CALL ZGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1),
+ $ LWORK-2*N, IERR )
+ CALL ZLACPY( 'L', N, NR, V, LDV, CWORK(2*N+1), N )
+*
+ DO 7969 p = 1, NR
+ CALL ZCOPY( NR-p+1, V(p,p), LDV, U(p,p), 1 )
+ CALL ZLACGV( NR-p+1, U(p,p), 1 )
+ 7969 CONTINUE
+
+ IF ( L2PERT ) THEN
+ XSC = SQRT(SMALL/EPSLN)
+ DO 9970 q = 2, NR
+ DO 9971 p = 1, q - 1
+ CTEMP = DCMPLX(XSC * MIN(ABS(U(p,p)),ABS(U(q,q))),
+ $ ZERO)
+* U(p,q) = - TEMP1 * ( U(q,p) / ABS(U(q,p)) )
+ U(p,q) = - CTEMP
+ 9971 CONTINUE
+ 9970 CONTINUE
+ ELSE
+ CALL ZLASET('U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU )
+ END IF
+
+ CALL ZGESVJ( 'L', 'U', 'V', NR, NR, U, LDU, SVA,
+ $ N, V, LDV, CWORK(2*N+N*NR+1), LWORK-2*N-N*NR,
+ $ RWORK, LRWORK, INFO )
+ SCALEM = RWORK(1)
+ NUMRANK = NINT(RWORK(2))
+
+ IF ( NR .LT. N ) THEN
+ CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV )
+ CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV )
+ CALL ZLASET( 'A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV )
+ END IF
+
+ CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1),
+ $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR )
+*
+* Permute the rows of V using the (column) permutation from the
+* first QRF. Also, scale the columns to make them unit in
+* Euclidean norm. This applies to all cases.
+*
+ TEMP1 = SQRT(DBLE(N)) * EPSLN
+ DO 7972 q = 1, N
+ DO 8972 p = 1, N
+ CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q)
+ 8972 CONTINUE
+ DO 8973 p = 1, N
+ V(p,q) = CWORK(2*N+N*NR+NR+p)
+ 8973 CONTINUE
+ XSC = ONE / DZNRM2( N, V(1,q), 1 )
+ IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) )
+ $ CALL ZDSCAL( N, XSC, V(1,q), 1 )
+ 7972 CONTINUE
+*
+* At this moment, V contains the right singular vectors of A.
+* Next, assemble the left singular vector matrix U (M x N).
+*
+ IF ( NR .LT. M ) THEN
+ CALL ZLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU )
+ IF ( NR .LT. N1 ) THEN
+ CALL ZLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU)
+ CALL ZLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1),LDU)
+ END IF
+ END IF
+*
+ CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U,
+ $ LDU, CWORK(N+1), LWORK-N, IERR )
+*
+ IF ( ROWPIV )
+ $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 )
+*
+*
+ END IF
+ IF ( TRANSP ) THEN
+* .. swap U and V because the procedure worked on A^*
+ DO 6974 p = 1, N
+ CALL ZSWAP( N, U(1,p), 1, V(1,p), 1 )
+ 6974 CONTINUE
+ END IF
+*
+ END IF
+* end of the full SVD
+*
+* Undo scaling, if necessary (and possible)
+*
+ IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN
+ CALL DLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR )
+ USCAL1 = ONE
+ USCAL2 = ONE
+ END IF
+*
+ IF ( NR .LT. N ) THEN
+ DO 3004 p = NR+1, N
+ SVA(p) = ZERO
+ 3004 CONTINUE
+ END IF
+*
+ RWORK(1) = USCAL2 * SCALEM
+ RWORK(2) = USCAL1
+ IF ( ERREST ) RWORK(3) = SCONDA
+ IF ( LSVEC .AND. RSVEC ) THEN
+ RWORK(4) = CONDR1
+ RWORK(5) = CONDR2
+ END IF
+ IF ( L2TRAN ) THEN
+ RWORK(6) = ENTRA
+ RWORK(7) = ENTRAT
+ END IF
+*
+ IWORK(1) = NR
+ IWORK(2) = NUMRANK
+ IWORK(3) = WARNING
+ IF ( TRANSP ) THEN
+ IWORK(4) = 1
+ ELSE
+ IWORK(4) = -1
+ END IF
+
+*
+ RETURN
+* ..
+* .. END OF ZGEJSV
+* ..
+ END
+*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleGEcomputational
*
*>
*> \verbatim
*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
+*> The matrix V stores the elementary reflectors H(i) in the i-th row
+*> above the diagonal. For example, if M=5 and N=3, the matrix V is
*>
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
*>
*> where the vi's represent the vectors which define H(i), which are returned
*> in the matrix A. The 1's along the diagonal of V are not stored in A.
-*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each
-*> block is of order NB except for the last block, which is of order
-*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
-*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
+*> Let K=MIN(M,N). The number of blocks is B = ceiling(K/MB), where each
+*> block is of order MB except for the last block, which is of order
+*> IB = K - (B-1)*MB. For each of the B blocks, a upper triangular block
+*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB
+*> for the last block) T's are stored in the MB-by-K matrix T as
*>
*> T = (T1 T2 ... TB).
*> \endverbatim
* =====================================================================
SUBROUTINE ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDT, M, N, MB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
*>
*> \verbatim
*>
-*> The matrix V stores the elementary reflectors H(i) in the i-th column
-*> below the diagonal. For example, if M=5 and N=3, the matrix V is
+*> The matrix V stores the elementary reflectors H(i) in the i-th row
+*> above the diagonal. For example, if M=5 and N=3, the matrix V is
*>
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
* =====================================================================
RECURSIVE SUBROUTINE ZGELQT3( M, N, A, LDA, T, LDT, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, LDT
PARAMETER ( ZERO = (0.0D+00,0.0D+00))
* ..
* .. Local Scalars ..
- INTEGER I, I1, J, J1, M1, M2, N1, N2, IINFO
+ INTEGER I, I1, J, J1, M1, M2, IINFO
* ..
* .. External Subroutines ..
EXTERNAL ZLARFG, ZTRMM, ZGEMM, XERBLA
*> of the matrices B and X. NRHS >= 0.
*> \endverbatim
*>
-*> \param[in] A
+*> \param[in,out] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> On entry, the M-by-N matrix A.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEsolve
*
SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
$ WORK, LWORK, RWORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
-*> Download DGEMQRT + dependencies
+*> Download DGEMLQT + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgemlqt.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgemlqt.f">
*>
*> \verbatim
*>
-*> ZGEMQRT overwrites the general real M-by-N matrix C with
+*> ZGEMLQT overwrites the general real M-by-N matrix C with
*>
*> SIDE = 'L' SIDE = 'R'
*> TRANS = 'N': Q C C Q
-*> TRANS = 'C': Q**C C C Q**C
+*> TRANS = 'C': Q**H C C Q**H
*>
*> where Q is a complex orthogonal matrix defined as the product of K
*> elementary reflectors:
*>
-*> Q = H(1) H(2) . . . H(K) = I - V C V**C
+*> Q = H(1) H(2) . . . H(K) = I - V T V**H
*>
*> generated using the compact WY representation as returned by ZGELQT.
*>
*> \param[in] SIDE
*> \verbatim
*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**C from the Left;
-*> = 'R': apply Q or Q**C from the Right.
+*> = 'L': apply Q or Q**H from the Left;
+*> = 'R': apply Q or Q**H from the Right.
*> \endverbatim
*>
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': No transpose, apply Q;
-*> = 'C': Transpose, apply Q**C.
+*> = 'C': Transpose, apply Q**H.
*> \endverbatim
*>
*> \param[in] M
*>
*> \param[in] V
*> \verbatim
-*> V is COMPLEX*16 array, dimension (LDV,K)
+*> V is COMPLEX*16 array, dimension
+*> (LDV,M) if SIDE = 'L',
+*> (LDV,N) if SIDE = 'R'
*> The i-th row must contain the vector which defines the
*> elementary reflector H(i), for i = 1,2,...,k, as returned by
*> DGELQT in the first K rows of its array argument A.
*> \param[in] LDV
*> \verbatim
*> LDV is INTEGER
-*> The leading dimension of the array V.
-*> If SIDE = 'L', LDA >= max(1,M);
-*> if SIDE = 'R', LDA >= max(1,N).
+*> The leading dimension of the array V. LDV >= max(1,K).
*> \endverbatim
*>
*> \param[in] T
*> \verbatim
*> T is COMPLEX*16 array, dimension (LDT,K)
*> The upper triangular factors of the block reflectors
-*> as returned by DGELQT, stored as a MB-by-M matrix.
+*> as returned by DGELQT, stored as a MB-by-K matrix.
*> \endverbatim
*>
*> \param[in] LDT
*> \verbatim
*> C is COMPLEX*16 array, dimension (LDC,N)
*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q C, Q**C C, C Q**C or C Q.
+*> On exit, C is overwritten by Q C, Q**H C, C Q**H or C Q.
*> \endverbatim
*>
*> \param[in] LDC
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup doubleGEcomputational
*
SUBROUTINE ZGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT,
$ C, LDC, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN
- INTEGER I, IB, LDWORK, KF, Q
+ INTEGER I, IB, LDWORK, KF
* ..
* .. External Functions ..
LOGICAL LSAME
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEcomputational
*
*> block is of order NB except for the last block, which is of order
*> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block
*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-*> for the last block) T's are stored in the NB-by-N matrix T as
+*> for the last block) T's are stored in the NB-by-K matrix T as
*>
*> T = (T1 T2 ... TB).
*> \endverbatim
* =====================================================================
SUBROUTINE ZGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDT, M, N, NB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16GEauxiliary
*
* =====================================================================
SUBROUTINE ZGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER LDA, N
COMPLEX*16 TEMP
* ..
* .. External Subroutines ..
- EXTERNAL ZLASWP, ZSCAL
+ EXTERNAL ZLASWP, ZSCAL, DLABAD
* ..
* .. External Functions ..
INTEGER IZAMAX
-*> \brief <b> ZGESV computes the solution to system of linear equations A * X = B for GE matrices</b> (simple driver) </b>
+*> \brief <b> ZGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) </b>
*
* =========== DOCUMENTATION ===========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEsolve
*
* =====================================================================
SUBROUTINE ZGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, N, NRHS
$ IL, IU, NS, S, U, LDU, VT, LDVT, WORK,
$ LWORK, RWORK, IWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
DOUBLE PRECISION DUM( 1 )
* ..
* .. External Subroutines ..
- EXTERNAL ZGEBRD, ZGELQF, ZGEQRF, ZLASCL, ZLASET,
- $ DLASCL, XERBLA
+ EXTERNAL ZGEBRD, ZGELQF, ZGEQRF, ZLASCL, ZLASET, ZLACPY,
+ $ ZUNMLQ, ZUNMBR, ZUNMQR, DBDSVDX, DLASCL, XERBLA
* ..
* .. External Functions ..
LOGICAL LSAME
*
*> \param[in] JOBA
*> \verbatim
-*> JOBA is CHARACTER* 1
+*> JOBA is CHARACTER*1
*> Specifies the structure of A.
*> = 'L': The input matrix A is lower triangular;
*> = 'U': The input matrix A is upper triangular;
*>
*> \param[in,out] CWORK
*> \verbatim
-*> CWORK is COMPLEX*16 array, dimension max(1,LWORK).
+*> CWORK is COMPLEX*16 array, dimension (max(1,LWORK))
*> Used as workspace.
*> If on entry LWORK .EQ. -1, then a workspace query is assumed and
*> no computation is done; CWORK(1) is set to the minial (and optimal)
*>
*> \param[in,out] RWORK
*> \verbatim
-*> RWORK is DOUBLE PRECISION array, dimension max(6,LRWORK).
+*> RWORK is DOUBLE PRECISION array, dimension (max(6,LRWORK))
*> On entry,
*> If JOBU .EQ. 'C' :
*> RWORK(1) = CTOL, where CTOL defines the threshold for convergence.
*> \par References:
* ================
*>
+*> \verbatim
+*>
*> [1] P. P. M. De Rijk: A one-sided Jacobi algorithm for computing the
*> singular value decomposition on a vector computer.
*> SIAM J. Sci. Stat. Comp., Vol. 10 (1998), pp. 359-371.
SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
$ LDV, CWORK, LWORK, RWORK, LRWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. External Subroutines ..
* ..
* from BLAS
- EXTERNAL ZCOPY, ZROT, ZDSCAL, ZSWAP
+ EXTERNAL ZCOPY, ZROT, ZDSCAL, ZSWAP, ZAXPY
* from LAPACK
EXTERNAL DLASCL, ZLASCL, ZLASET, ZLASSQ, XERBLA
EXTERNAL ZGSVJ0, ZGSVJ1
* =====================================================================
SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
DOUBLE PRECISION BIGNUM, EPS, SMIN, SMLNUM, XMAX
* ..
* .. External Subroutines ..
- EXTERNAL ZGERU, ZSWAP
+ EXTERNAL ZGERU, ZSWAP, DLABAD
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMCH
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': the linear system involves A;
-*> = 'C': the linear system involves A**C.
+*> = 'C': the linear system involves A**H.
*> \endverbatim
*>
*> \param[in] M
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEsolve
*
SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS
INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW,
$ SCLLEN, MNK, TSZO, TSZM, LWO, LWM, LW1, LW2,
$ WSIZEO, WSIZEM, INFO2
- DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM
- COMPLEX*16 TQ( 5 ), WORKQ
+ DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM, DUM( 1 )
+ COMPLEX*16 TQ( 5 ), WORKQ( 1 )
* ..
* .. External Functions ..
LOGICAL LSAME
IF( M.GE.N ) THEN
CALL ZGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
- LWO = INT( WORKQ )
+ LWO = INT( WORKQ( 1 ) )
CALL ZGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWO = MAX( LWO, INT( WORKQ ) )
+ LWO = MAX( LWO, INT( WORKQ( 1 ) ) )
CALL ZGEQR( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
TSZM = INT( TQ( 1 ) )
- LWM = INT( WORKQ )
+ LWM = INT( WORKQ( 1 ) )
CALL ZGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
$ TSZM, B, LDB, WORKQ, -1, INFO2 )
- LWM = MAX( LWM, INT( WORKQ ) )
+ LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
WSIZEO = TSZO + LWO
WSIZEM = TSZM + LWM
ELSE
CALL ZGELQ( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
TSZO = INT( TQ( 1 ) )
- LWO = INT( WORKQ )
+ LWO = INT( WORKQ( 1 ) )
CALL ZGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWO = MAX( LWO, INT( WORKQ ) )
+ LWO = MAX( LWO, INT( WORKQ( 1 ) ) )
CALL ZGELQ( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
TSZM = INT( TQ( 1 ) )
- LWM = INT( WORKQ )
+ LWM = INT( WORKQ( 1 ) )
CALL ZGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
- LWM = MAX( LWM, INT( WORKQ ) )
+ LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
WSIZEO = TSZO + LWO
WSIZEM = TSZM + LWM
END IF
*
* Scale A, B if max element outside range [SMLNUM,BIGNUM]
*
- ANRM = ZLANGE( 'M', M, N, A, LDA, WORK )
+ ANRM = ZLANGE( 'M', M, N, A, LDA, DUM )
IASCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
*
IF ( TRAN ) THEN
BROW = N
END IF
- BNRM = ZLANGE( 'M', BROW, NRHS, B, LDB, WORK )
+ BNRM = ZLANGE( 'M', BROW, NRHS, B, LDB, DUM )
IBSCL = 0
IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
*
*>
*> \param[in] SELCTG
*> \verbatim
-*> SELCTG is procedure) LOGICAL FUNCTION of two COMPLEX*16 arguments
+*> SELCTG is a LOGICAL FUNCTION of two COMPLEX*16 arguments
*> SELCTG must be declared EXTERNAL in the calling subroutine.
*> If SORT = 'N', SELCTG is not referenced.
*> If SORT = 'S', SELCTG is used to select eigenvalues to sort
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEeigen
*
$ LDVSR, RCONDE, RCONDV, WORK, LWORK, RWORK,
$ IWORK, LIWORK, BWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBVSL, JOBVSR, SENSE, SORT
SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
$ LDQ, Z, LDZ, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.6.1) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2015
EXTERNAL ILAENV, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL ZGGHRD, ZLARTG, ZLASET, ZUNM22, ZROT, XERBLA
+ EXTERNAL ZGGHRD, ZLARTG, ZLASET, ZUNM22, ZROT, ZGEMM,
+ $ ZGEMV, ZTRMV, ZLACPY, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, DCMPLX, DCONJG, MAX
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension LWORK.
+*> WORK is COMPLEX*16 array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS,
$ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* .. External Subroutines ..
* ..
* from BLAS
- EXTERNAL ZCOPY, ZROT, ZSWAP
+ EXTERNAL ZCOPY, ZROT, ZSWAP, ZAXPY
* from LAPACK
EXTERNAL ZLASCL, ZLASSQ, XERBLA
* ..
SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV,
$ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Subroutines ..
* .. from BLAS
- EXTERNAL ZCOPY, ZROT, ZSWAP
+ EXTERNAL ZCOPY, ZROT, ZSWAP, ZAXPY
* .. from LAPACK
EXTERNAL ZLASCL, ZLASSQ, XERBLA
* ..
* Arguments:
* ==========
*
-*> @param[in] n
-*> The order of the matrix A.
-*>
-*> @param[in] nb
-*> The size of the band.
-*>
-*> @param[in, out] A
-*> A pointer to the matrix A.
-*>
-*> @param[in] lda
-*> The leading dimension of the matrix A.
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> \endverbatim
*>
-*> @param[out] V
-*> COMPLEX*16 array, dimension 2*n if eigenvalues only are
-*> requested or to be queried for vectors.
+*> \param[in] WANTZ
+*> \verbatim
+*> WANTZ is LOGICAL which indicate if Eigenvalue are requested or both
+*> Eigenvalue/Eigenvectors.
+*> \endverbatim
*>
-*> @param[out] TAU
-*> COMPLEX*16 array, dimension (2*n).
-*> The scalar factors of the Householder reflectors are stored
-*> in this array.
+*> \param[in] TTYPE
+*> \verbatim
+*> TTYPE is INTEGER
+*> \endverbatim
*>
-*> @param[in] st
+*> \param[in] ST
+*> \verbatim
+*> ST is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] ed
+*> \param[in] ED
+*> \verbatim
+*> ED is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] sweep
+*> \param[in] SWEEP
+*> \verbatim
+*> SWEEP is INTEGER
*> internal parameter for indices.
+*> \endverbatim
*>
-*> @param[in] Vblksiz
-*> internal parameter for indices.
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER. The order of the matrix A.
+*> \endverbatim
*>
-*> @param[in] wantz
-*> logical which indicate if Eigenvalue are requested or both
-*> Eigenvalue/Eigenvectors.
+*> \param[in] NB
+*> \verbatim
+*> NB is INTEGER. The size of the band.
+*> \endverbatim
+*>
+*> \param[in] IB
+*> \verbatim
+*> IB is INTEGER.
+*> \endverbatim
+*>
+*> \param[in, out] A
+*> \verbatim
+*> A is COMPLEX*16 array. A pointer to the matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER. The leading dimension of the matrix A.
+*> \endverbatim
+*>
+*> \param[out] V
+*> \verbatim
+*> V is COMPLEX*16 array, dimension 2*n if eigenvalues only are
+*> requested or to be queried for vectors.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX*16 array, dimension (2*n).
+*> The scalar factors of the Householder reflectors are stored
+*> in this array.
+*> \endverbatim
+*>
+*> \param[in] LDVT
+*> \verbatim
+*> LDVT is INTEGER.
+*> \endverbatim
*>
-*> @param[in] work
-*> Workspace of size nb.
+*> \param[in] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array. Workspace of size nb.
+*> \endverbatim
*>
*> \par Further Details:
* =====================
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHEReigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, ZLANHB
- EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV
+ EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DSCAL, DSTERF, XERBLA, ZLASCL, ZSTEQR,
- $ ZHETRD_2STAGE
+ $ ZHETRD_2STAGE, ZHETRD_HB2ST
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, SQRT
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- IB = ILAENV( 18, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = LHTRD + LWTRD
WORK( 1 ) = LWMIN
ENDIF
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHEReigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, ZLANHB
- EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV
+ EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DSCAL, DSTERF, XERBLA, ZGEMM, ZLACPY,
LRWMIN = 1
LIWMIN = 1
ELSE
- IB = ILAENV( 18, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
IF( WANTZ ) THEN
LWMIN = 2*N**2
LRWMIN = 1 + 5*N + 2*N**2
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, ZLANHB
- EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV
+ EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZCOPY,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- IB = ILAENV( 18, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 )
+ IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = LHTRD + LWTRD
WORK( 1 ) = LWMIN
ENDIF
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16HEcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE ZHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
$ WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* =====================================================================
*
* .. Parameters ..
- REAL ONE, ZERO
+ DOUBLE PRECISION ONE, ZERO
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16HEcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE ZHECON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* =====================================================================
*
* .. Parameters ..
- REAL ONE, ZERO
+ DOUBLE PRECISION ONE, ZERO
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
* =====================================================================
SUBROUTINE ZHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
EXTERNAL DLAMCH, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL ZLASSQ
+ EXTERNAL ZLASSQ, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DIMAG, INT, LOG, MAX, MIN, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, ZLANHE
- EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE
+ EXTERNAL LSAME, DLAMCH, ZLANHE, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DSCAL, DSTERF, XERBLA, ZLASCL, ZSTEQR,
END IF
*
IF( INFO.EQ.0 ) THEN
- KD = ILAENV( 17, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, ZLANHE
- EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE
+ EXTERNAL LSAME, DLAMCH, ZLANHE, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DSCAL, DSTERF, XERBLA, ZLACPY, ZLASCL,
LRWMIN = 1
LIWMIN = 1
ELSE
- KD = ILAENV( 17, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ,
+ $ N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
IF( WANTZ ) THEN
LWMIN = 2*N + N*N
LRWMIN = 1 + 5*N + 2*N**2
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV, ILAENV2STAGE
DOUBLE PRECISION DLAMCH, ZLANSY
- EXTERNAL LSAME, ILAENV, DLAMCH, ZLANSY
+ EXTERNAL LSAME, DLAMCH, ZLANSY, ILAENV, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL,
LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR.
$ ( LIWORK.EQ.-1 ) )
*
- KD = ILAENV( 17, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
LRWMIN = MAX( 1, 24*N )
LIWMIN = MAX( 1, 10*N )
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
+ INTEGER ILAENV2STAGE
DOUBLE PRECISION DLAMCH, ZLANHE
- EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE
+ EXTERNAL LSAME, DLAMCH, ZLANHE, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL,
LWMIN = 1
WORK( 1 ) = LWMIN
ELSE
- KD = ILAENV( 17, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ,
+ $ N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ,
+ $ N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ,
+ $ N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
END IF
*> positive definite.
*> This routine use the 2stage technique for the reduction to tridiagonal
*> which showed higher performance on recent architecture and for large
-* sizes N>2000.
+*> sizes N>2000.
*> \endverbatim
*
* Arguments:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEeigen
*
*
IMPLICIT NONE
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ INTEGER ILAENV2STAGE
+ EXTERNAL LSAME, ILAENV2STAGE
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZHEGST, ZPOTRF, ZTRMM, ZTRSM,
END IF
*
IF( INFO.EQ.0 ) THEN
- KD = ILAENV( 17, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
- IB = ILAENV( 18, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
- LHTRD = ILAENV( 19, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
- LWTRD = ILAENV( 20, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 )
+ LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
+ LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 )
LWMIN = N + LHTRD + LWTRD
WORK( 1 ) = LWMIN
*
*> The length of WORK. LWORK >= MAX(1,2*N,3*N-2), and for best
*> performance LWORK >= max(1,N*NB), where NB is the optimal
*> blocksize for ZHETRF.
-*> for LWORK < N, TRS will be done with Level BLAS 2
-*> for LWORK >= N, TRS will be done with Level BLAS 3
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEsolve
*
SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZHETRF, ZHETRS, ZHETRS2
+ EXTERNAL XERBLA, ZHETRF_AA, ZHETRS_AA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief <b> ZHESV_AA_2STAGE computes the solution to system of linear equations A * X = B for HE matrices</b>
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHESV_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhesv_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhesv_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhesv_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+* IPIV, IPIV2, B, LDB, WORK, LWORK,
+* INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX*16 A( LDA, * ), TB( * ), B( LDB, *), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZHESV_AA_2STAGE computes the solution to a complex system of
+*> linear equations
+*> A * X = B,
+*> where A is an N-by-N Hermitian matrix and X and B are N-by-NRHS
+*> matrices.
+*>
+*> Aasen's 2-stage algorithm is used to factor A as
+*> A = U * T * U**H, if UPLO = 'U', or
+*> A = L * T * L**H, if UPLO = 'L',
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is Hermitian and band. The matrix T is
+*> then LU-factored with partial pivoting. The factored form of A
+*> is then used to solve the system of equations A * X = B.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the hermitian matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX*16 array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16HEsolve
+*
+* =====================================================================
+ SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, WORK, LWORK,
+ $ INFO )
+*
+* -- LAPACK driver routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LDB, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX*16 A( LDA, * ), B( LDB, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+* .. Parameters ..
+ COMPLEX*16 ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ ONE = ( 1.0D+0, 0.0D+0 ) )
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER I, J, K, I1, I2, TD
+ INTEGER LDTB, LWKOPT, NB, KB, NT, IINFO
+ COMPLEX PIV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZHETRF_AA_2STAGE, ZHETRS_AA_2STAGE
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ CALL ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
+ $ IPIV2, WORK, -1, INFO )
+ LWKOPT = INT( WORK(1) )
+ IF( LTB.LT.INT( TB(1) ) .AND. .NOT.TQUERY ) THEN
+ INFO = -7
+ ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.WQUERY ) THEN
+ INFO = -13
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZHESV_AA_2STAGE', -INFO )
+ RETURN
+ ELSE IF( WQUERY .OR. TQUERY ) THEN
+ RETURN
+ END IF
+*
+* Compute the factorization A = U*T*U**H or A = L*T*L**H.
+*
+ CALL ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
+ $ WORK, LWORK, INFO )
+ IF( INFO.EQ.0 ) THEN
+*
+* Solve the system A*X = B, overwriting B with X.
+*
+ CALL ZHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, B, LDB, INFO )
+*
+ END IF
+*
+ WORK( 1 ) = LWKOPT
+*
+ RETURN
+*
+* End of ZHESV_AA_2STAGE
+*
+ END
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension LWORK.
+*> WORK is COMPLEX*16 array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEcomputational
*
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER VECT, UPLO
* ..
* .. External Functions ..
LOGICAL LSAME
- INTEGER ILAENV
- EXTERNAL LSAME, ILAENV
+ INTEGER ILAENV2STAGE
+ EXTERNAL LSAME, ILAENV2STAGE
* ..
* .. Executable Statements ..
*
*
* Determine the block size, the workspace size and the hous size.
*
- KD = ILAENV( 17, 'ZHETRD_2STAGE', VECT, N, -1, -1, -1 )
- IB = ILAENV( 18, 'ZHETRD_2STAGE', VECT, N, KD, -1, -1 )
- LHMIN = ILAENV( 19, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 )
- LWMIN = ILAENV( 20, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 )
+ KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', VECT, N, -1, -1, -1 )
+ IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', VECT, N, KD, -1, -1 )
+ LHMIN = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 )
+ LWMIN = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 )
* WRITE(*,*),'ZHETRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
* $ LHMIN, LWMIN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHERcomputational
*
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER STAGE1, UPLO, VECT
COMPLEX*16 TMP
* ..
* .. External Subroutines ..
- EXTERNAL ZHB2ST_KERNELS, ZLACPY, ZLASET
+ EXTERNAL ZHB2ST_KERNELS, ZLACPY, ZLASET, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MIN, MAX, CEILING, DBLE, REAL
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension LWORK.
+*> WORK is COMPLEX*16 array, dimension (LWORK)
*> On exit, if INFO = 0, or if LWORK=-1,
*> WORK(1) returns the size of LWORK.
*> \endverbatim
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK which should be calculated
-* by a workspace query. LWORK = MAX(1, LWORK_QUERY)
+*> by a workspace query. LWORK = MAX(1, LWORK_QUERY)
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEcomputational
*
*>
*> where tau is a complex scalar, and v is a complex vector with
*> v(kd+1:i) = 0 and v(i+kd+1) = 1; v(i+kd+2:n) is stored on exit in
-* A(i+kd+2:n,i), and tau in TAU(i).
+*> A(i+kd+2:n,i), and tau in TAU(i).
*>
*> The contents of A on exit are illustrated by the following examples
*> with n = 5:
*
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
$ TPOS, WPOS, S2POS, S1POS
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZHER2K, ZHEMM, ZGEMM,
+ EXTERNAL XERBLA, ZHER2K, ZHEMM, ZGEMM, ZCOPY,
$ ZLARFT, ZGELQF, ZGEQRF, ZLASET
* ..
* .. Intrinsic Functions ..
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEcomputational
*
* =====================================================================
SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
*
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
- INTEGER J, LWKOPT, IINFO
+ INTEGER J, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
COMPLEX*16 ALPHA
* ..
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL ZLAHEF_AA, ZGEMM, ZGEMV, ZCOPY, ZSCAL, ZSWAP, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, DCONJG, MAX
*
* Determine the block size
*
- NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
+ NB = ILAENV( 1, 'ZHETRF_AA', UPLO, N, -1, -1, -1 )
*
* Test the input parameters.
*
IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN
A( 1, 1 ) = DBLE( A( 1, 1 ) )
- IF ( A( 1, 1 ).EQ.ZERO ) THEN
- INFO = 1
- END IF
RETURN
END IF
*
-* Adjubst block size based on the workspace size
+* Adjust block size based on the workspace size
*
IF( LWORK.LT.((1+NB)*N) ) THEN
NB = ( LWORK-N ) / N
*
CALL ZLAHEF_AA( UPLO, 2-K1, N-J, JB,
$ A( MAX(1, J), J+1 ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
- $ IINFO )
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
*
CALL ZLAHEF_AA( UPLO, 2-K1, N-J, JB,
$ A( J+1, MAX(1, J) ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
--- /dev/null
+*> \brief \b ZHETRF_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETRF_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrf_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrf_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrf_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+* IPIV2, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX*16 A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZHETRF_AA_2STAGE computes the factorization of a double hermitian matrix A
+*> using the Aasen's algorithm. The form of the factorization is
+*>
+*> A = U*T*U**T or A = L*T*L**T
+*>
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is a hermitian band matrix with the
+*> bandwidth of NB (NB is internally selected and stored in TB( 1 ), and T is
+*> LU factorized with partial pivoting).
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> On entry, the hermitian matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16SYcomputational
+*
+* =====================================================================
+ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, WORK, LWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX*16 A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+* .. Parameters ..
+ COMPLEX*16 ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ),
+ $ ONE = ( 1.0E+0, 0.0E+0 ) )
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER I, J, K, I1, I2, TD
+ INTEGER LDTB, NB, KB, JB, NT, IINFO
+ COMPLEX*16 PIV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZCOPY, ZLACGV, ZLACPY,
+ $ ZLASET, ZGBTRF, ZGEMM, ZGETRF,
+ $ ZHEGST, ZSWAP, ZTRSM
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG, MIN, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN
+ INFO = -6
+ ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN
+ INFO = -10
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZHETRF_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Answer the query
+*
+ NB = ILAENV( 1, 'ZHETRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
+ IF( INFO.EQ.0 ) THEN
+ IF( TQUERY ) THEN
+ TB( 1 ) = (3*NB+1)*N
+ END IF
+ IF( WQUERY ) THEN
+ WORK( 1 ) = N*NB
+ END IF
+ END IF
+ IF( TQUERY .OR. WQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return
+*
+ IF ( N.EQ.0 ) THEN
+ RETURN
+ ENDIF
+*
+* Determine the number of the block size
+*
+ LDTB = LTB/N
+ IF( LDTB .LT. 3*NB+1 ) THEN
+ NB = (LDTB-1)/3
+ END IF
+ IF( LWORK .LT. NB*N ) THEN
+ NB = LWORK/N
+ END IF
+*
+* Determine the number of the block columns
+*
+ NT = (N+NB-1)/NB
+ TD = 2*NB
+ KB = MIN(NB, N)
+*
+* Initialize vectors/matrices
+*
+ DO J = 1, KB
+ IPIV( J ) = J
+ END DO
+*
+* Save NB
+*
+ TB( 1 ) = NB
+*
+ IF( UPPER ) THEN
+*
+* .....................................................
+* Factorize A as L*D*L**T using the upper triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*U(I,J) + T(I+1,I)*U(I+1,J)
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( (I-1)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*U(I-1,J) + T(I,I)*U(I,J) + T(I,I+1)*U(I+1,J)
+ IF( I .EQ. (J-1) ) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (I-2)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL ZLACPY( 'Upper', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = U(1:J,J)'*H(1:J)
+ CALL ZGEMM( 'Conjugate transpose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -ONE, A( 1, J*NB+1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += U(J,J)'*T(J,J-1)*U(J-1,J)
+ CALL ZGEMM( 'Conjugate transpose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ ONE, A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ ZERO, WORK( 1 ), N )
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB,
+ $ -ONE, WORK( 1 ), N,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+ IF( J.GT.0 ) THEN
+ CALL ZHEGST( 1, 'Upper', KB,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA, IINFO )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ TB( TD+1 + (J*NB+I-1)*LDTB )
+ $ = REAL( TB( TD+1 + (J*NB+I-1)*LDTB ) )
+ DO K = I+1, KB
+ TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ $ = DCONJG( TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB ) )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, KB,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB+KB,
+ $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL ZGEMM( 'Conjugate transpose', 'NoTranspose',
+ $ NB, N-(J+1)*NB, J*NB,
+ $ -ONE, WORK( NB+1 ), N,
+ $ A( 1, (J+1)*NB+1 ), LDA,
+ $ ONE, A( J*NB+1, (J+1)*NB+1 ), LDA )
+ END IF
+*
+* Copy panel to workspace to call ZGETRF
+*
+ DO K = 1, NB
+ CALL ZCOPY( N-(J+1)*NB,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA,
+ $ WORK( 1+(K-1)*N ), 1 )
+ END DO
+*
+* Factorize panel
+*
+ CALL ZGETRF( N-(J+1)*NB, NB,
+ $ WORK, N,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Copy panel back
+*
+ DO K = 1, NB
+*
+* Copy only L-factor
+*
+ CALL ZCOPY( N-K-(J+1)*NB,
+ $ WORK( K+1+(K-1)*N ), 1,
+ $ A( J*NB+K, (J+1)*NB+K+1 ), LDA )
+*
+* Transpose U-factor to be copied back into T(J+1, J)
+*
+ CALL ZLACGV( K, WORK( 1+(K-1)*N ), 1 )
+ END DO
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL ZLASET( 'Full', KB, NB, ZERO, ZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB) , LDTB-1 )
+ CALL ZLACPY( 'Upper', KB, NB,
+ $ WORK, N,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL ZTRSM( 'R', 'U', 'N', 'U', KB, NB, ONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J,J+1) into T(J+1, J), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB )
+ $ = DCONJG( TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB ) )
+ END DO
+ END DO
+ CALL ZLASET( 'Lower', KB, NB, ZERO, ONE,
+ $ A( J*NB+1, (J+1)*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL ZSWAP( K-1, A( (J+1)*NB+1, I1 ), 1,
+ $ A( (J+1)*NB+1, I2 ), 1 )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL ZSWAP( I2-I1-1, A( I1, I1+1 ), LDA,
+ $ A( I1+1, I2 ), 1 )
+ CALL ZLACGV( I2-I1, A( I1, I1+1 ), LDA )
+ CALL ZLACGV( I2-I1-1, A( I1+1, I2 ), 1 )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL ZSWAP( N-I2, A( I1, I2+1 ), LDA,
+ $ A( I2, I2+1 ), LDA )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL ZSWAP( J*NB, A( 1, I1 ), 1,
+ $ A( 1, I2 ), 1 )
+ END IF
+ ENDIF
+ END DO
+ END IF
+ END DO
+ ELSE
+*
+* .....................................................
+* Factorize A as L*D*L**T using the lower triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*L(J,I)' + T(I+1,I)'*L(J,I+1)'
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL ZGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (I-1)*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*L(J,I-1)' + T(I,I)*L(J,I)' + T(I,I+1)*L(J,I+1)'
+ IF( I .EQ. (J-1) ) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL ZGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ NB, KB, JB,
+ $ ONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (I-2)*NB+1 ), LDA,
+ $ ZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL ZLACPY( 'Lower', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = L(J,1:J)*H(1:J)
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -ONE, A( J*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += L(J,J)*T(J,J-1)*L(J,J-1)'
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ ONE, A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ ZERO, WORK( 1 ), N )
+ CALL ZGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ KB, KB, NB,
+ $ -ONE, WORK( 1 ), N,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+ IF( J.GT.0 ) THEN
+ CALL ZHEGST( 1, 'Lower', KB,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA, IINFO )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ TB( TD+1 + (J*NB+I-1)*LDTB )
+ $ = REAL( TB( TD+1 + (J*NB+I-1)*LDTB ) )
+ DO K = I+1, KB
+ TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ $ = DCONJG( TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB ) )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL ZGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ KB, KB, KB,
+ $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL ZGEMM( 'NoTranspose', 'Conjugate transpose',
+ $ KB, KB, NB+KB,
+ $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ ZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ N-(J+1)*NB, NB, J*NB,
+ $ -ONE, A( (J+1)*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ ONE, A( (J+1)*NB+1, J*NB+1 ), LDA )
+ END IF
+*
+* Factorize panel
+*
+ CALL ZGETRF( N-(J+1)*NB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL ZLASET( 'Full', KB, NB, ZERO, ZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB) , LDTB-1 )
+ CALL ZLACPY( 'Upper', KB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL ZTRSM( 'R', 'L', 'C', 'U', KB, NB, ONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J+1,J) into T(J, J+1), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB )
+ $ = DCONJG( TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB ) )
+ END DO
+ END DO
+ CALL ZLASET( 'Upper', KB, NB, ZERO, ONE,
+ $ A( (J+1)*NB+1, J*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL ZSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA,
+ $ A( I2, (J+1)*NB+1 ), LDA )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL ZSWAP( I2-I1-1, A( I1+1, I1 ), 1,
+ $ A( I2, I1+1 ), LDA )
+ CALL ZLACGV( I2-I1, A( I1+1, I1 ), 1 )
+ CALL ZLACGV( I2-I1-1, A( I2, I1+1 ), LDA )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL ZSWAP( N-I2, A( I2+1, I1 ), 1,
+ $ A( I2+1, I2 ), 1 )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL ZSWAP( J*NB, A( I1, 1 ), LDA,
+ $ A( I2, 1 ), LDA )
+ END IF
+ ENDIF
+ END DO
+*
+* Apply pivots to previous columns of L
+*
+c CALL ZLASWP( J*NB, A( 1, 1 ), LDA,
+c $ (J+1)*NB+1, (J+1)*NB+KB, IPIV, 1 )
+ END IF
+ END DO
+ END IF
+*
+* Factor the band matrix
+ CALL ZGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO )
+*
+* End of ZHETRF_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEcomputational
*
* =====================================================================
SUBROUTINE ZHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL ZHETRI2X
+ EXTERNAL ZHETRI2X, ZHETRI, XERBLA
* ..
* .. Executable Statements ..
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16HEcomputational
*
* =====================================================================
SUBROUTINE ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* =====================================================================
*
* .. Parameters ..
- REAL ONE
+ DOUBLE PRECISION ONE
COMPLEX*16 CONE, ZERO
PARAMETER ( ONE = 1.0D+0,
$ CONE = ( 1.0D+0, 0.0D+0 ),
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE ZHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL ZHETRI_3X
+ EXTERNAL ZHETRI_3X, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16HEcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE ZHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16HEcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> of the matrix B. NRHS >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> Details of factors computed by ZHETRF_AA.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEcomputational
*
SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL ZGTSV, ZSWAP, ZTRSM, XERBLA
+ EXTERNAL ZGTSV, ZSWAP, ZTRSM, ZLACGV, ZLACPY, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief \b ZHETRS_AA_2STAGE
+*
+* @generated from SRC/dsytrs_aa_2stage.f, fortran d -> c, Mon Oct 30 11:59:02 2017
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHETRS_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrs_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrs_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrs_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+* IPIV2, B, LDB, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX*16 A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZHETRS_AA_2STAGE solves a system of linear equations A*X = B with a
+*> hermitian matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by ZHETRF_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the details of the factorization are stored
+*> as an upper or lower triangular matrix.
+*> = 'U': Upper triangular, form is A = U*T*U**T;
+*> = 'L': Lower triangular, form is A = L*T*L**T.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX*16array, dimension (LDA,N)
+*> Details of factors computed by ZHETRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX*16array, dimension (LTB)
+*> Details of factors computed by ZHETRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> ZHETRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] IPIV2
+*> \verbatim
+*> IPIV2 is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> ZHETRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX*16array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16SYcomputational
+*
+* =====================================================================
+ SUBROUTINE ZHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX*16 A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+* =====================================================================
+*
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER LDTB, NB
+ LOGICAL UPPER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGBTRS, ZLASWP, ZTRSM, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LTB.LT.( 4*N ) ) THEN
+ INFO = -7
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZHETRS_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. NRHS.EQ.0 )
+ $ RETURN
+*
+* Read NB and compute LDTB
+*
+ NB = INT( TB( 1 ) )
+ LDTB = LTB/N
+*
+ IF( UPPER ) THEN
+*
+* Solve A*X = B, where A = U*T*U**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ]
+*
+ CALL ZTRSM( 'L', 'U', 'C', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (U**T \P**T * B) ]
+*
+ CALL ZGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ]
+*
+ CALL ZTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ]
+*
+ CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+*
+ ELSE
+*
+* Solve A*X = B, where A = L*T*L**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
+*
+ CALL ZTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (L \P**T * B) ]
+*
+ CALL ZGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
+*
+ CALL ZTRSM( 'L', 'L', 'C', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
+*
+ CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZHETRS_AA_2STAGE
+*
+ END
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION (LDA,ka)
+*> A is COMPLEX*16 array, dimension (LDA,ka)
*> where KA
*> is K when TRANS = 'N' or 'n', and is N otherwise. Before
*> entry with TRANS = 'N' or 'n', the leading N--by--K part of
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHERcomputational
*
SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
$ C )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA, BETA
*>
*> \param[out] RWORK
*> \verbatim
-*> RWORK is DOUBLE PRECISION array,
-*> dimension (LRWORK)
+*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK))
*> On exit, if INFO = 0, RWORK(1) returns the required LRWORK.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHEReigen
*
SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
$ RWORK, LRWORK, IWORK, LIWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBZ, UPLO
*>
*> \param[in] AB
*> \verbatim
-*> AB is COMPLEX*16 array of DIMENSION ( LDAB, n )
+*> AB is COMPLEX*16 array, dimension ( LDAB, n )
*> Before entry, the leading m by n part of the array AB must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GBcomputational
*
SUBROUTINE ZLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
$ INCX, BETA, Y, INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA, BETA
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GBcomputational
*
$ Y_TAIL, RCOND, ITHRESH, RTHRESH,
$ DZ_UB, IGNORE_CWISE, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDAB, LDAFB, LDB, LDY, N, KL, KU, NRHS,
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array of DIMENSION ( LDA, n )
+*> A is COMPLEX*16 array, dimension ( LDA, n )
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array of DIMENSION at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
*> and at least
*> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEcomputational
*
SUBROUTINE ZLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
$ Y, INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA, BETA
*>
*> \param[in,out] ERRS_N
*> \verbatim
-*> ERRS_N is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERRS_N is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERRS_C
*> \verbatim
-*> ERRS_C is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERRS_C is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEcomputational
*
$ Y_TAIL, RCOND, ITHRESH, RTHRESH,
$ DZ_UB, IGNORE_CWISE, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array, DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, n ).
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array, DIMENSION at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) )
*> Before entry, the incremented array X must contain the
*> vector x.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16HEcomputational
*
SUBROUTINE ZLA_HEAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
$ INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA, BETA
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX*16 array, dimension
-*> (LDY,NRHS)
+*> Y is COMPLEX*16 array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by ZHETRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16HEcomputational
*
$ RTHRESH, DZ_UB, IGNORE_CWISE,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX*16 array, dimension
-*> (LDY,NRHS)
+*> Y is COMPLEX*16 array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by ZPOTRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16POcomputational
*
$ RTHRESH, DZ_UB, IGNORE_CWISE,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array, DIMENSION ( LDA, n ).
+*> A is COMPLEX*16 array, dimension ( LDA, n ).
*> Before entry, the leading m by n part of the array A must
*> contain the matrix of coefficients.
*> Unchanged on exit.
*>
*> \param[in] X
*> \verbatim
-*> X is COMPLEX*16 array, DIMENSION at least
+*> X is COMPLEX*16 array, dimension at least
*> ( 1 + ( n - 1 )*abs( INCX ) )
*> Before entry, the incremented array X must contain the
*> vector x.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16SYcomputational
*
SUBROUTINE ZLA_SYAMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
$ INCY )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA, BETA
*>
*> \param[in,out] Y
*> \verbatim
-*> Y is COMPLEX*16 array, dimension
-*> (LDY,NRHS)
+*> Y is COMPLEX*16 array, dimension (LDY,NRHS)
*> On entry, the solution matrix X, as computed by ZSYTRS.
*> On exit, the improved solution matrix Y.
*> \endverbatim
*>
*> \param[in,out] ERR_BNDS_NORM
*> \verbatim
-*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_NORM is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> normwise relative error, which is defined as follows:
*>
*> \param[in,out] ERR_BNDS_COMP
*> \verbatim
-*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension
-*> (NRHS, N_ERR_BNDS)
+*> ERR_BNDS_COMP is DOUBLE PRECISION array, dimension (NRHS, N_ERR_BNDS)
*> For each right-hand side, this array contains information about
*> various error bounds and condition numbers corresponding to the
*> componentwise relative error, which is defined as follows:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16SYcomputational
*
$ RTHRESH, DZ_UB, IGNORE_CWISE,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
*>
*> \param[out] TAUQ
*> \verbatim
-*> TAUQ is COMPLEX*16 array dimension (NB)
+*> TAUQ is COMPLEX*16 array, dimension (NB)
*> The scalar factors of the elementary reflectors which
*> represent the unitary matrix Q. See Further Details.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHERauxiliary
*
SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
$ LDY )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, LDX, LDY, M, N, NB
* ===========
*
* SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-* H, LDH, WORK, INFO )
+* H, LDH, WORK )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
-* INTEGER J1, M, NB, LDA, LDH, INFO
+* INTEGER J1, M, NB, LDA, LDH
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
*> WORK is COMPLEX*16 workspace, dimension (M).
*> \endverbatim
*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
*
* Authors:
* ========
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16HEcomputational
*
* =====================================================================
SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
- $ H, LDH, WORK, INFO )
+ $ H, LDH, WORK )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
* .. Scalar Arguments ..
CHARACTER UPLO
- INTEGER M, NB, J1, LDA, LDH, INFO
+ INTEGER M, NB, J1, LDA, LDH
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
PARAMETER ( ZERO = (0.0D+0, 0.0D+0), ONE = (1.0D+0, 0.0D+0) )
*
* .. Local Scalars ..
- INTEGER J, K, K1, I1, I2
+ INTEGER J, K, K1, I1, I2, MJ
COMPLEX*16 PIV, ALPHA
* ..
* .. External Functions ..
EXTERNAL LSAME, ILAENV, IZAMAX
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL ZGEMM, ZGEMV, ZAXPY, ZLACGV, ZCOPY, ZSCAL, ZSWAP,
+ $ ZLASET, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, DCONJG, MAX
* ..
* .. Executable Statements ..
*
- INFO = 0
J = 1
*
* K1 is the first column of the panel to be factorized
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
* H(J:N, J) := A(J, J:N) - H(J:N, 1:(J-1)) * L(J1:(J-1), J),
* where H(J:N, J) has been initialized to be A(J, J:N)
* first column
*
CALL ZLACGV( J-K1, A( 1, J ), 1 )
- CALL ZGEMV( 'No transpose', M-J+1, J-K1,
+ CALL ZGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( 1, J ), 1,
$ ONE, H( J, J ), 1 )
*
* Copy H(i:n, i) into WORK
*
- CALL ZCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL ZCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
* where A(J-1, J) stores T(J-1, J) and A(J-2, J:N) stores U(J-1, J:N)
*
ALPHA = -DCONJG( A( K-1, J ) )
- CALL ZAXPY( M-J+1, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
+ CALL ZAXPY( MJ, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
* Set A(J, J+1) = T(J, J+1)
*
A( K, J+1 ) = WORK( 2 )
- IF( (A( K, J ).EQ.ZERO ) .AND.
- $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
- IF(INFO .EQ. 0) THEN
- INFO = J
- END IF
- END IF
*
IF( J.LT.NB ) THEN
*
CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO,
$ A( K, J+2 ), LDA)
END IF
- ELSE
- IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 10
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
* H(J:N, J) := A(J:N, J) - H(J:N, 1:(J-1)) * L(J, J1:(J-1))^T,
* where H(J:N, J) has been initialized to be A(J:N, J)
* first column
*
CALL ZLACGV( J-K1, A( J, 1 ), LDA )
- CALL ZGEMV( 'No transpose', M-J+1, J-K1,
+ CALL ZGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( J, 1 ), LDA,
$ ONE, H( J, J ), 1 )
*
* Copy H(J:N, J) into WORK
*
- CALL ZCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL ZCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
* where A(J-1, J) = T(J-1, J) and A(J, J-2) = L(J, J-1)
*
ALPHA = -DCONJG( A( J, K-1 ) )
- CALL ZAXPY( M-J+1, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
+ CALL ZAXPY( MJ, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
* Set A(J+1, J) = T(J+1, J)
*
A( J+1, K ) = WORK( 2 )
- IF( (A( J, K ).EQ.ZERO) .AND.
- $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
- IF (INFO .EQ. 0)
- $ INFO = J
- END IF
*
IF( J.LT.NB ) THEN
*
CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO,
$ A( J+2, K ), LDA )
END IF
- ELSE
- IF( (A( J, K ).EQ.ZERO) .AND. (J.EQ.M)
- $ .AND. (INFO.EQ.0) ) INFO = J
END IF
J = J + 1
GO TO 30
*>
*> \param[out] IWORK
*> \verbatim
-*> IWORK is INTEGER array.
-*> The dimension must be at least 3 * N
+*> IWORK is INTEGER array, dimension (3*N)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHERcomputational
*
$ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, RWORK,
$ IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension at least
-*> (N * NRHS).
+*> WORK is COMPLEX*16 array, dimension (N * NRHS)
*> \endverbatim
*>
*> \param[out] RWORK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHERcomputational
*
SUBROUTINE ZLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND,
$ RANK, WORK, RWORK, IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*>
*> SIDE = 'L' SIDE = 'R'
*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
+*> TRANS = 'C': Q**H * C C * Q**H
*> where Q is a real orthogonal matrix defined as the product of blocked
*> elementary reflectors computed by short wide LQ
*> factorization (ZLASWLQ)
*> \param[in] SIDE
*> \verbatim
*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
+*> = 'L': apply Q or Q**H from the Left;
+*> = 'R': apply Q or Q**H from the Right.
*> \endverbatim
*>
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': No transpose, apply Q;
-*> = 'T': Transpose, apply Q**T.
+*> = 'C': Conjugate Transpose, apply Q**H.
*> \endverbatim
*>
*> \param[in] M
*> \verbatim
*> M is INTEGER
-*> The number of rows of the matrix A. M >=0.
+*> The number of rows of the matrix C. M >=0.
*> \endverbatim
*>
*> \param[in] N
*>
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,K)
+*> A is COMPLEX*16 array, dimension
+*> (LDA,M) if SIDE = 'L',
+*> (LDA,N) if SIDE = 'R'
*> The i-th row must contain the vector which defines the blocked
*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DLASWLQ in the first k rows of its array argument A.
+*> ZLASWLQ in the first k rows of its array argument A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> C is COMPLEX*16 array, dimension (LDC,N)
*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
*> \endverbatim
*>
*> \param[in] LDC
SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
- INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC, LW
+ INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * ), WORK( * ), C(LDC, * ),
* ..
* .. Local Scalars ..
LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
- INTEGER I, II, KK, CTR
+ INTEGER I, II, KK, LW, CTR
* ..
* .. External Functions ..
LOGICAL LSAME
*>
*> SIDE = 'L' SIDE = 'R'
*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'C': Q**C * C C * Q**C
+*> TRANS = 'C': Q**H * C C * Q**H
*> where Q is a real orthogonal matrix defined as the product
*> of blocked elementary reflectors computed by tall skinny
*> QR factorization (ZLATSQR)
*> \param[in] SIDE
*> \verbatim
*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**T from the Left;
-*> = 'R': apply Q or Q**T from the Right.
+*> = 'L': apply Q or Q**H from the Left;
+*> = 'R': apply Q or Q**H from the Right.
*> \endverbatim
*>
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': No transpose, apply Q;
-*> = 'C': Conjugate Transpose, apply Q**C.
+*> = 'C': Conjugate Transpose, apply Q**H.
*> \endverbatim
*>
*> \param[in] M
*> N >= NB >= 1.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,K)
*> The i-th column must contain the vector which defines the
*> \verbatim
*> C is COMPLEX*16 array, dimension (LDC,N)
*> On entry, the M-by-N matrix C.
-*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
*> \endverbatim
*>
*> \param[in] LDC
SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,
$ LDT, C, LDC, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
*
*> \param[in] N
*> \verbatim
-*> N is integer
+*> N is INTEGER
*> Order of the matrix H. N must be either 2 or 3.
*> \endverbatim
*>
*> \param[in] H
*> \verbatim
-*> H is COMPLEX*16 array of dimension (LDH,N)
+*> H is COMPLEX*16 array, dimension (LDH,N)
*> The 2-by-2 or 3-by-3 matrix H in (*).
*> \endverbatim
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> The leading dimension of H as declared in
*> the calling procedure. LDH.GE.N
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
-*> V is COMPLEX*16 array of dimension N
+*> V is COMPLEX*16 array, dimension (N)
*> A scalar multiple of the first column of the
*> matrix K in (*).
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHERauxiliary
*
* =====================================================================
SUBROUTINE ZLAQR1( N, H, LDH, S1, S2, V )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
COMPLEX*16 S1, S2
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> Leading dimension of H just as declared in the calling
*> subroutine. N .LE. LDH
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer
+*> LDZ is INTEGER
*> The leading dimension of Z just as declared in the
*> calling subroutine. 1 .LE. LDZ.
*> \endverbatim
*>
*> \param[out] NS
*> \verbatim
-*> NS is integer
+*> NS is INTEGER
*> The number of unconverged (ie approximate) eigenvalues
*> returned in SR and SI that may be used as shifts by the
*> calling subroutine.
*>
*> \param[out] ND
*> \verbatim
-*> ND is integer
+*> ND is INTEGER
*> The number of converged eigenvalues uncovered by this
*> subroutine.
*> \endverbatim
*>
*> \param[out] SH
*> \verbatim
-*> SH is COMPLEX*16 array, dimension KBOT
+*> SH is COMPLEX*16 array, dimension (KBOT)
*> On output, approximate eigenvalues that may
*> be used for shifts are stored in SH(KBOT-ND-NS+1)
*> through SR(KBOT-ND). Converged eigenvalues are
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> The leading dimension of V just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> The number of columns of T. NH.GE.NW.
*> \endverbatim
*>
*>
*> \param[in] LDT
*> \verbatim
-*> LDT is integer
+*> LDT is INTEGER
*> The leading dimension of T just as declared in the
*> calling subroutine. NW .LE. LDT
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer
+*> NV is INTEGER
*> The number of rows of work array WV available for
*> workspace. NV.GE.NW.
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer
+*> LDWV is INTEGER
*> The leading dimension of W just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension LWORK.
+*> WORK is COMPLEX*16 array, dimension (LWORK)
*> On exit, WORK(1) is set to an estimate of the optimal value
*> of LWORK for the given values of N, NW, KTOP and KBOT.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
-*> LWORK is integer
+*> LWORK is INTEGER
*> The dimension of the work array WORK. LWORK = 2*NW
*> suffices, but greater efficiency may result from larger
*> values of LWORK.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHERauxiliary
*
$ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
$ NV, WV, LDWV, WORK, LWORK )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer
+*> LDH is INTEGER
*> Leading dimension of H just as declared in the calling
*> subroutine. N .LE. LDH
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer
+*> LDZ is INTEGER
*> The leading dimension of Z just as declared in the
*> calling subroutine. 1 .LE. LDZ.
*> \endverbatim
*>
*> \param[out] NS
*> \verbatim
-*> NS is integer
+*> NS is INTEGER
*> The number of unconverged (ie approximate) eigenvalues
*> returned in SR and SI that may be used as shifts by the
*> calling subroutine.
*>
*> \param[out] ND
*> \verbatim
-*> ND is integer
+*> ND is INTEGER
*> The number of converged eigenvalues uncovered by this
*> subroutine.
*> \endverbatim
*>
*> \param[out] SH
*> \verbatim
-*> SH is COMPLEX*16 array, dimension KBOT
+*> SH is COMPLEX*16 array, dimension (KBOT)
*> On output, approximate eigenvalues that may
*> be used for shifts are stored in SH(KBOT-ND-NS+1)
*> through SR(KBOT-ND). Converged eigenvalues are
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> The leading dimension of V just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> The number of columns of T. NH.GE.NW.
*> \endverbatim
*>
*>
*> \param[in] LDT
*> \verbatim
-*> LDT is integer
+*> LDT is INTEGER
*> The leading dimension of T just as declared in the
*> calling subroutine. NW .LE. LDT
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer
+*> NV is INTEGER
*> The number of rows of work array WV available for
*> workspace. NV.GE.NW.
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer
+*> LDWV is INTEGER
*> The leading dimension of W just as declared in the
*> calling subroutine. NW .LE. LDV
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension LWORK.
+*> WORK is COMPLEX*16 array, dimension (LWORK)
*> On exit, WORK(1) is set to an estimate of the optimal value
*> of LWORK for the given values of N, NW, KTOP and KBOT.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
-*> LWORK is integer
+*> LWORK is INTEGER
*> The dimension of the work array WORK. LWORK = 2*NW
*> suffices, but greater efficiency may result from larger
*> values of LWORK.
$ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
$ NV, WV, LDWV, WORK, LWORK )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*
*> \param[in] WANTT
*> \verbatim
-*> WANTT is logical scalar
+*> WANTT is LOGICAL
*> WANTT = .true. if the triangular Schur factor
*> is being computed. WANTT is set to .false. otherwise.
*> \endverbatim
*>
*> \param[in] WANTZ
*> \verbatim
-*> WANTZ is logical scalar
+*> WANTZ is LOGICAL
*> WANTZ = .true. if the unitary Schur factor is being
*> computed. WANTZ is set to .false. otherwise.
*> \endverbatim
*>
*> \param[in] KACC22
*> \verbatim
-*> KACC22 is integer with value 0, 1, or 2.
+*> KACC22 is INTEGER with value 0, 1, or 2.
*> Specifies the computation mode of far-from-diagonal
*> orthogonal updates.
*> = 0: ZLAQR5 does not accumulate reflections and does not
*>
*> \param[in] N
*> \verbatim
-*> N is integer scalar
+*> N is INTEGER
*> N is the order of the Hessenberg matrix H upon which this
*> subroutine operates.
*> \endverbatim
*>
*> \param[in] KTOP
*> \verbatim
-*> KTOP is integer scalar
+*> KTOP is INTEGER
*> \endverbatim
*>
*> \param[in] KBOT
*> \verbatim
-*> KBOT is integer scalar
+*> KBOT is INTEGER
*> These are the first and last rows and columns of an
*> isolated diagonal block upon which the QR sweep is to be
*> applied. It is assumed without a check that
*>
*> \param[in] NSHFTS
*> \verbatim
-*> NSHFTS is integer scalar
+*> NSHFTS is INTEGER
*> NSHFTS gives the number of simultaneous shifts. NSHFTS
*> must be positive and even.
*> \endverbatim
*>
*> \param[in,out] S
*> \verbatim
-*> S is COMPLEX*16 array of size (NSHFTS)
+*> S is COMPLEX*16 array, dimension (NSHFTS)
*> S contains the shifts of origin that define the multi-
*> shift QR sweep. On output S may be reordered.
*> \endverbatim
*>
*> \param[in,out] H
*> \verbatim
-*> H is COMPLEX*16 array of size (LDH,N)
+*> H is COMPLEX*16 array, dimension (LDH,N)
*> On input H contains a Hessenberg matrix. On output a
*> multi-shift QR sweep with shifts SR(J)+i*SI(J) is applied
*> to the isolated diagonal block in rows and columns KTOP
*>
*> \param[in] LDH
*> \verbatim
-*> LDH is integer scalar
+*> LDH is INTEGER
*> LDH is the leading dimension of H just as declared in the
*> calling procedure. LDH.GE.MAX(1,N).
*> \endverbatim
*>
*> \param[in,out] Z
*> \verbatim
-*> Z is COMPLEX*16 array of size (LDZ,IHIZ)
+*> Z is COMPLEX*16 array, dimension (LDZ,IHIZ)
*> If WANTZ = .TRUE., then the QR Sweep unitary
*> similarity transformation is accumulated into
*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right.
*>
*> \param[in] LDZ
*> \verbatim
-*> LDZ is integer scalar
+*> LDZ is INTEGER
*> LDA is the leading dimension of Z just as declared in
*> the calling procedure. LDZ.GE.N.
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
-*> V is COMPLEX*16 array of size (LDV,NSHFTS/2)
+*> V is COMPLEX*16 array, dimension (LDV,NSHFTS/2)
*> \endverbatim
*>
*> \param[in] LDV
*> \verbatim
-*> LDV is integer scalar
+*> LDV is INTEGER
*> LDV is the leading dimension of V as declared in the
*> calling procedure. LDV.GE.3.
*> \endverbatim
*>
*> \param[out] U
*> \verbatim
-*> U is COMPLEX*16 array of size
-*> (LDU,3*NSHFTS-3)
+*> U is COMPLEX*16 array, dimension (LDU,3*NSHFTS-3)
*> \endverbatim
*>
*> \param[in] LDU
*> \verbatim
-*> LDU is integer scalar
+*> LDU is INTEGER
*> LDU is the leading dimension of U just as declared in the
*> in the calling subroutine. LDU.GE.3*NSHFTS-3.
*> \endverbatim
*>
*> \param[in] NH
*> \verbatim
-*> NH is integer scalar
+*> NH is INTEGER
*> NH is the number of columns in array WH available for
*> workspace. NH.GE.1.
*> \endverbatim
*>
*> \param[out] WH
*> \verbatim
-*> WH is COMPLEX*16 array of size (LDWH,NH)
+*> WH is COMPLEX*16 array, dimension (LDWH,NH)
*> \endverbatim
*>
*> \param[in] LDWH
*> \verbatim
-*> LDWH is integer scalar
+*> LDWH is INTEGER
*> Leading dimension of WH just as declared in the
*> calling procedure. LDWH.GE.3*NSHFTS-3.
*> \endverbatim
*>
*> \param[in] NV
*> \verbatim
-*> NV is integer scalar
+*> NV is INTEGER
*> NV is the number of rows in WV agailable for workspace.
*> NV.GE.1.
*> \endverbatim
*>
*> \param[out] WV
*> \verbatim
-*> WV is COMPLEX*16 array of size
-*> (LDWV,3*NSHFTS-3)
+*> WV is COMPLEX*16 array, dimension (LDWV,3*NSHFTS-3)
*> \endverbatim
*>
*> \param[in] LDWV
*> \verbatim
-*> LDWV is integer scalar
+*> LDWV is INTEGER
*> LDWV is the leading dimension of WV as declared in the
*> in the calling subroutine. LDWV.GE.NV.
*> \endverbatim
$ H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV,
$ WV, LDWV, NH, WH, LDWH )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHERauxiliary
*
* =====================================================================
SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX, N
BETA = BETA*RSAFMN
ALPHI = ALPHI*RSAFMN
ALPHR = ALPHR*RSAFMN
- IF( ABS( BETA ).LT.SAFMIN .AND. KNT .LT. 1000)
+ IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) )
$ GO TO 10
*
* New BETA is at most 1, at least SAFMIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHERauxiliary
*
* =====================================================================
SUBROUTINE ZLARFGP( N, ALPHA, X, INCX, TAU )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX, N
BETA = BETA*BIGNUM
ALPHI = ALPHI*BIGNUM
ALPHR = ALPHR*BIGNUM
- IF( ABS( BETA ).LT.SMLNUM .AND. KNT .LT. 1000)
+ IF( (ABS( BETA ).LT.SMLNUM) .AND. (KNT .LT. 20) )
$ GO TO 10
*
* New BETA is at most 1, at least SMLNUM
$ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ,
$ WORK, IWORK, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
* ..
INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ RETURN
+ END IF
+*
* The first N entries of WORK are reserved for the eigenvalues
INDLD = N+1
INDLLD= 2*N+1
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> On entry, the M-by-N matrix A.
-*> On exit, the elements on and bleow the diagonal
+*> On exit, the elements on and below the diagonal
*> of the array contain the N-by-N lower triangular matrix L;
*> the elements above the diagonal represent Q by the rows
*> of blocked V (see Further Details).
SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
$ INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
*> \verbatim
*> IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
*> The vector of pivot indices. Only the elements in positions
-*> K1 through K1+(K2-K1)*INCX of IPIV are accessed.
-*> IPIV(K) = L implies rows K and L are to be interchanged.
+*> K1 through K1+(K2-K1)*abs(INCX) of IPIV are accessed.
+*> IPIV(K1+(K-K1)*abs(INCX)) = L implies rows K and L are to be
+*> interchanged.
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
-*> The increment between successive values of IPIV. If IPIV
+*> The increment between successive values of IPIV. If INCX
*> is negative, the pivots are applied in reverse order.
*> \endverbatim
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHERauxiliary
*
* =====================================================================
SUBROUTINE ZLASWP( N, A, LDA, K1, K2, IPIV, INCX )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INCX, K1, K2, LDA, N
* ..
* .. Executable Statements ..
*
-* Interchange row I with row IPIV(I) for each of rows K1 through K2.
+* Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
+* K1 through K2.
*
IF( INCX.GT.0 ) THEN
IX0 = K1
* ===========
*
* SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
-* H, LDH, WORK, INFO )
+* H, LDH, WORK )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
-* INTEGER J1, M, NB, LDA, LDH, INFO
+* INTEGER J1, M, NB, LDA, LDH
* ..
* .. Array Arguments ..
* INTEGER IPIV( * )
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[out] IPIV
*> \verbatim
-*> IPIV is INTEGER array, dimension (N)
+*> IPIV is INTEGER array, dimension (M)
*> Details of the row and column interchanges,
*> the row and column k were interchanged with the row and
*> column IPIV(k).
*> WORK is COMPLEX*16 workspace, dimension (M).
*> \endverbatim
*>
-*> \param[out] INFO
-*> \verbatim
-*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
-*> \endverbatim
*
* Authors:
* ========
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16SYcomputational
*
* =====================================================================
SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
- $ H, LDH, WORK, INFO )
+ $ H, LDH, WORK )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
* .. Scalar Arguments ..
CHARACTER UPLO
- INTEGER M, NB, J1, LDA, LDH, INFO
+ INTEGER M, NB, J1, LDA, LDH
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
*
* .. Local Scalars ..
- INTEGER J, K, K1, I1, I2
+ INTEGER J, K, K1, I1, I2, MJ
COMPLEX*16 PIV, ALPHA
* ..
* .. External Functions ..
EXTERNAL LSAME, ILAENV, IZAMAX
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL ZGEMV, ZAXPY, ZSCAL, ZCOPY, ZSWAP, ZLASET,
+ $ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
* ..
* .. Executable Statements ..
*
- INFO = 0
J = 1
*
* K1 is the first column of the panel to be factorized
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
-* H(J:N, J) := A(J, J:N) - H(J:N, 1:(J-1)) * L(J1:(J-1), J),
-* where H(J:N, J) has been initialized to be A(J, J:N)
+* H(J:M, J) := A(J, J:M) - H(J:M, 1:(J-1)) * L(J1:(J-1), J),
+* where H(J:M, J) has been initialized to be A(J, J:M)
*
IF( K.GT.2 ) THEN
*
* > for the rest of the columns, K is J+1, skipping only the
* first column
*
- CALL ZGEMV( 'No transpose', M-J+1, J-K1,
+ CALL ZGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( 1, J ), 1,
$ ONE, H( J, J ), 1 )
END IF
*
-* Copy H(i:n, i) into WORK
+* Copy H(i:M, i) into WORK
*
- CALL ZCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL ZCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
-* Compute WORK := WORK - L(J-1, J:N) * T(J-1,J),
-* where A(J-1, J) stores T(J-1, J) and A(J-2, J:N) stores U(J-1, J:N)
+* Compute WORK := WORK - L(J-1, J:M) * T(J-1,J),
+* where A(J-1, J) stores T(J-1, J) and A(J-2, J:M) stores U(J-1, J:M)
*
ALPHA = -A( K-1, J )
- CALL ZAXPY( M-J+1, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
+ CALL ZAXPY( MJ, ALPHA, A( K-2, J ), LDA, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
*
IF( J.LT.M ) THEN
*
-* Compute WORK(2:N) = T(J, J) L(J, (J+1):N)
-* where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N)
+* Compute WORK(2:M) = T(J, J) L(J, (J+1):M)
+* where A(J, J) stores T(J, J) and A(J-1, (J+1):M) stores U(J, (J+1):M)
*
IF( K.GT.1 ) THEN
ALPHA = -A( K, J )
$ WORK( 2 ), 1 )
ENDIF
*
-* Find max(|WORK(2:n)|)
+* Find max(|WORK(2:M)|)
*
I2 = IZAMAX( M-J, WORK( 2 ), 1 ) + 1
PIV = WORK( I2 )
WORK( I2 ) = WORK( I1 )
WORK( I1 ) = PIV
*
-* Swap A(I1, I1+1:N) with A(I1+1:N, I2)
+* Swap A(I1, I1+1:M) with A(I1+1:M, I2)
*
I1 = I1+J-1
I2 = I2+J-1
CALL ZSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA,
$ A( J1+I1, I2 ), 1 )
*
-* Swap A(I1, I2+1:N) with A(I2, I2+1:N)
+* Swap A(I1, I2+1:M) with A(I2, I2+1:M)
*
CALL ZSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA,
$ A( J1+I2-1, I2+1 ), LDA )
* Set A(J, J+1) = T(J, J+1)
*
A( K, J+1 ) = WORK( 2 )
- IF( (A( K, J ).EQ.ZERO ) .AND.
- $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN
- IF(INFO .EQ. 0) THEN
- INFO = J
- ENDIF
- END IF
*
IF( J.LT.NB ) THEN
*
-* Copy A(J+1:N, J+1) into H(J:N, J),
+* Copy A(J+1:M, J+1) into H(J:M, J),
*
CALL ZCOPY( M-J, A( K+1, J+1 ), LDA,
$ H( J+1, J+1 ), 1 )
END IF
*
-* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
-* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
+* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
*
IF( A( K, J+1 ).NE.ZERO ) THEN
ALPHA = ONE / A( K, J+1 )
CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO,
$ A( K, J+2 ), LDA)
END IF
- ELSE
- IF( (A( K, J ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 10
* > for the rest of the columns, J1 is 2, and J1+J-1 is J+1,
*
K = J1+J-1
+ IF( J.EQ.M ) THEN
+*
+* Only need to compute T(J, J)
+*
+ MJ = 1
+ ELSE
+ MJ = M-J+1
+ END IF
*
-* H(J:N, J) := A(J:N, J) - H(J:N, 1:(J-1)) * L(J, J1:(J-1))^T,
-* where H(J:N, J) has been initialized to be A(J:N, J)
+* H(J:M, J) := A(J:M, J) - H(J:M, 1:(J-1)) * L(J, J1:(J-1))^T,
+* where H(J:M, J) has been initialized to be A(J:M, J)
*
IF( K.GT.2 ) THEN
*
* > for the rest of the columns, K is J+1, skipping only the
* first column
*
- CALL ZGEMV( 'No transpose', M-J+1, J-K1,
+ CALL ZGEMV( 'No transpose', MJ, J-K1,
$ -ONE, H( J, K1 ), LDH,
$ A( J, 1 ), LDA,
$ ONE, H( J, J ), 1 )
END IF
*
-* Copy H(J:N, J) into WORK
+* Copy H(J:M, J) into WORK
*
- CALL ZCOPY( M-J+1, H( J, J ), 1, WORK( 1 ), 1 )
+ CALL ZCOPY( MJ, H( J, J ), 1, WORK( 1 ), 1 )
*
IF( J.GT.K1 ) THEN
*
-* Compute WORK := WORK - L(J:N, J-1) * T(J-1,J),
+* Compute WORK := WORK - L(J:M, J-1) * T(J-1,J),
* where A(J-1, J) = T(J-1, J) and A(J, J-2) = L(J, J-1)
*
ALPHA = -A( J, K-1 )
- CALL ZAXPY( M-J+1, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
+ CALL ZAXPY( MJ, ALPHA, A( J, K-2 ), 1, WORK( 1 ), 1 )
END IF
*
* Set A(J, J) = T(J, J)
*
IF( J.LT.M ) THEN
*
-* Compute WORK(2:N) = T(J, J) L((J+1):N, J)
-* where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J)
+* Compute WORK(2:M) = T(J, J) L((J+1):M, J)
+* where A(J, J) = T(J, J) and A((J+1):M, J-1) = L((J+1):M, J)
*
IF( K.GT.1 ) THEN
ALPHA = -A( J, K )
$ WORK( 2 ), 1 )
ENDIF
*
-* Find max(|WORK(2:n)|)
+* Find max(|WORK(2:M)|)
*
I2 = IZAMAX( M-J, WORK( 2 ), 1 ) + 1
PIV = WORK( I2 )
WORK( I2 ) = WORK( I1 )
WORK( I1 ) = PIV
*
-* Swap A(I1+1:N, I1) with A(I2, I1+1:N)
+* Swap A(I1+1:M, I1) with A(I2, I1+1:M)
*
I1 = I1+J-1
I2 = I2+J-1
CALL ZSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1,
$ A( I2, J1+I1 ), LDA )
*
-* Swap A(I2+1:N, I1) with A(I2+1:N, I2)
+* Swap A(I2+1:M, I1) with A(I2+1:M, I2)
*
CALL ZSWAP( M-I2, A( I2+1, J1+I1-1 ), 1,
$ A( I2+1, J1+I2-1 ), 1 )
* Set A(J+1, J) = T(J+1, J)
*
A( J+1, K ) = WORK( 2 )
- IF( (A( J, K ).EQ.ZERO) .AND.
- $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN
- IF (INFO .EQ. 0)
- $ INFO = J
- END IF
*
IF( J.LT.NB ) THEN
*
-* Copy A(J+1:N, J+1) into H(J+1:N, J),
+* Copy A(J+1:M, J+1) into H(J+1:M, J),
*
CALL ZCOPY( M-J, A( J+1, K+1 ), 1,
$ H( J+1, J+1 ), 1 )
END IF
*
-* Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1),
-* where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1)
+* Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1),
+* where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1)
*
IF( A( J+1, K ).NE.ZERO ) THEN
ALPHA = ONE / A( J+1, K )
CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO,
$ A( J+2, K ), LDA )
END IF
- ELSE
- IF( (A( J, K ).EQ.ZERO) .AND. (INFO.EQ.0) ) THEN
- INFO = J
- END IF
END IF
J = J + 1
GO TO 30
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHERauxiliary
*
SUBROUTINE ZLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
$ SCALE, CNORM, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER DIAG, NORMIN, TRANS, UPLO
$ ZDOTU, ZLADIV
* ..
* .. External Subroutines ..
- EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTBSV
+ EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTBSV, DLABAD
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHERauxiliary
*
SUBROUTINE ZLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE,
$ CNORM, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER DIAG, NORMIN, TRANS, UPLO
$ ZDOTU, ZLADIV
* ..
* .. External Subroutines ..
- EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTPSV
+ EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTPSV, DLABAD
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHERauxiliary
*
SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
$ CNORM, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER DIAG, NORMIN, TRANS, UPLO
$ ZDOTU, ZLADIV
* ..
* .. External Subroutines ..
- EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV
+ EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV, DLABAD
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
*>
*> \param[out] RWORK
*> \verbatim
-*> RWORK is DOUBLE PRECISION array,
-*> dimension (LRWORK)
+*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK))
*> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHERcomputational
*
SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK,
$ LRWORK, IWORK, LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER COMPZ
*>
*> \param[out] ISUPPZ
*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
+*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
*> The support of the eigenvectors in Z, i.e., the indices
*> indicating the nonzero elements in Z. The i-th computed eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
$ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[out] ISUPPZ
*> \verbatim
-*> ISUPPZ is INTEGER ARRAY, dimension ( 2*max(1,M) )
+*> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
*> The support of the eigenvectors in Z, i.e., the indices
*> indicating the nonzero elements in Z. The i-th computed eigenvector
*> is nonzero only in elements ISUPPZ( 2*i-1 ) through
$ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK,
$ IWORK, LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16SYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE ZSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND,
$ WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* Definition:
* ===========
*
-* SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+* SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16SYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO, WAY
* Definition:
* ===========
*
-* SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
+* SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
* .. Scalar Arguments ..
* CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16SYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO, WAY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16SYcomputational
*
* =====================================================================
SUBROUTINE ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, N
EXTERNAL DLAMCH, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL ZLASSQ
+ EXTERNAL ZLASSQ, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DIMAG, INT, LOG, MAX, MIN, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16SYsolve
*
SUBROUTINE ZSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
$ LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.7.0) --
+* -- LAPACK driver routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL ILAENV, LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZSYTRF, ZSYTRS, ZSYTRS2
+ EXTERNAL XERBLA, ZSYTRF_AA, ZSYTRS_AA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief <b> ZSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices</b>
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYSV_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsysv_aasen_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsysv_aasen_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsysv_aasen_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+* IPIV, IPIV2, B, LDB, WORK, LWORK,
+* INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX*16 A( LDA, * ), TB( * ), B( LDB, *), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZSYSV_AA_2STAGE computes the solution to a complex system of
+*> linear equations
+*> A * X = B,
+*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
+*> matrices.
+*>
+*> Aasen's 2-stage algorithm is used to factor A as
+*> A = U * T * U**H, if UPLO = 'U', or
+*> A = L * T * L**H, if UPLO = 'L',
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is symmetric and band. The matrix T is
+*> then LU-factored with partial pivoting. The factored form of A
+*> is then used to solve the system of equations A * X = B.
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX*16 array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16SYcomputational
+*
+* =====================================================================
+ SUBROUTINE ZSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, WORK, LWORK,
+ $ INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LDB, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX*16 A( LDA, * ), B( LDB, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER LWKOPT
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZSYTRF_AA_2STAGE,
+ $ ZSYTRS_AA_2STAGE
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ CALL ZSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
+ $ IPIV2, WORK, -1, INFO )
+ LWKOPT = INT( WORK(1) )
+ IF( LTB.LT.INT( TB(1) ) .AND. .NOT.TQUERY ) THEN
+ INFO = -7
+ ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.WQUERY ) THEN
+ INFO = -13
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZSYSV_AA_2STAGE', -INFO )
+ RETURN
+ ELSE IF( WQUERY .OR. TQUERY ) THEN
+ RETURN
+ END IF
+*
+*
+* Compute the factorization A = U*T*U**H or A = L*T*L**H.
+*
+ CALL ZSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
+ $ WORK, LWORK, INFO )
+ IF( INFO.EQ.0 ) THEN
+*
+* Solve the system A*X = B, overwriting B with X.
+*
+ CALL ZSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, B, LDB, INFO )
+*
+ END IF
+*
+ WORK( 1 ) = LWKOPT
+*
+* End of ZSYSV_AA_2STAGE
+*
+ END
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
-*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
-*> has been completed, but the block diagonal matrix D is
-*> exactly singular, and division by zero will occur if it
-*> is used to solve a system of equations.
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16SYcomputational
*
* =====================================================================
SUBROUTINE ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
*
* .. Local Scalars ..
LOGICAL LQUERY, UPPER
- INTEGER J, LWKOPT, IINFO
+ INTEGER J, LWKOPT
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
COMPLEX*16 ALPHA
* ..
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL ZLASYF_AA, ZGEMM, ZGEMV, ZSCAL, ZCOPY,
+ $ ZSWAP, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*
* Determine the block size
*
- NB = ILAENV( 1, 'ZSYTRF', UPLO, N, -1, -1, -1 )
+ NB = ILAENV( 1, 'ZSYTRF_AA', UPLO, N, -1, -1, -1 )
*
* Test the input parameters.
*
ENDIF
IPIV( 1 ) = 1
IF ( N.EQ.1 ) THEN
- IF ( A( 1, 1 ).EQ.ZERO ) THEN
- INFO = 1
- END IF
RETURN
END IF
*
-* Adjubst block size based on the workspace size
+* Adjust block size based on the workspace size
*
IF( LWORK.LT.((1+NB)*N) ) THEN
NB = ( LWORK-N ) / N
*
CALL ZLASYF_AA( UPLO, 2-K1, N-J, JB,
$ A( MAX(1, J), J+1 ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
- $ IINFO )
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
*
CALL ZLASYF_AA( UPLO, 2-K1, N-J, JB,
$ A( J+1, MAX(1, J) ), LDA,
- $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
- IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
- INFO = IINFO+J
- ENDIF
+ $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
*
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
*
--- /dev/null
+*> \brief \b ZSYTRF_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYTRF_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csytrf_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csytrf_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csytrf_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+* IPIV2, WORK, LWORK, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX*16 A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZSYTRF_AA_2STAGE computes the factorization of a complex symmetric matrix A
+*> using the Aasen's algorithm. The form of the factorization is
+*>
+*> A = U*T*U**T or A = L*T*L**T
+*>
+*> where U (or L) is a product of permutation and unit upper (lower)
+*> triangular matrices, and T is a complex symmetric band matrix with the
+*> bandwidth of NB (NB is internally selected and stored in TB( 1 ), and T is
+*> LU factorized with partial pivoting).
+*>
+*> This is the blocked version of the algorithm, calling Level 3 BLAS.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> = 'U': Upper triangle of A is stored;
+*> = 'L': Lower triangle of A is stored.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the hermitian matrix A. If UPLO = 'U', the leading
+*> N-by-N upper triangular part of A contains the upper
+*> triangular part of the matrix A, and the strictly lower
+*> triangular part of A is not referenced. If UPLO = 'L', the
+*> leading N-by-N lower triangular part of A contains the lower
+*> triangular part of the matrix A, and the strictly upper
+*> triangular part of A is not referenced.
+*>
+*> On exit, L is stored below (or above) the subdiaonal blocks,
+*> when UPLO is 'L' (or 'U').
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX*16 array, dimension (LTB)
+*> On exit, details of the LU factorization of the band matrix.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N, internally
+*> used to select NB such that LTB >= (3*NB+1)*N.
+*>
+*> If LTB = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of LTB,
+*> returns this value as the first entry of TB, and
+*> no error message related to LTB is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of A were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] IPIV2
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> On exit, it contains the details of the interchanges, i.e.,
+*> the row and column k of T were interchanged with the
+*> row and column IPIV(k).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 workspace of size LWORK
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> The size of WORK. LWORK >= N, internally used to select NB
+*> such that LWORK >= N*NB.
+*>
+*> If LWORK = -1, then a workspace query is assumed; the
+*> routine only calculates the optimal size of the WORK array,
+*> returns this value as the first entry of the WORK array, and
+*> no error message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value.
+*> > 0: if INFO = i, band LU factorization failed on i-th column
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16SYcomputational
+*
+* =====================================================================
+ SUBROUTINE ZSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV,
+ $ IPIV2, WORK, LWORK, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, LDA, LTB, LWORK, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX*16 A( LDA, * ), TB( * ), WORK( * )
+* ..
+*
+* =====================================================================
+* .. Parameters ..
+ COMPLEX*16 CZERO, CONE
+ PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
+ $ CONE = ( 1.0D+0, 0.0D+0 ) )
+*
+* .. Local Scalars ..
+ LOGICAL UPPER, TQUERY, WQUERY
+ INTEGER I, J, K, I1, I2, TD
+ INTEGER LDTB, NB, KB, JB, NT, IINFO
+ COMPLEX*16 PIV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZCOPY, ZGBTRF, ZGEMM, ZGETRF,
+ $ ZLACPY, ZLASET, ZLASWP, ZTRSM, ZSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ WQUERY = ( LWORK.EQ.-1 )
+ TQUERY = ( LTB.EQ.-1 )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN
+ INFO = -6
+ ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN
+ INFO = -10
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZSYTRF_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Answer the query
+*
+ NB = ILAENV( 1, 'ZSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 )
+ IF( INFO.EQ.0 ) THEN
+ IF( TQUERY ) THEN
+ TB( 1 ) = (3*NB+1)*N
+ END IF
+ IF( WQUERY ) THEN
+ WORK( 1 ) = N*NB
+ END IF
+ END IF
+ IF( TQUERY .OR. WQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return
+*
+ IF ( N.EQ.0 ) THEN
+ RETURN
+ ENDIF
+*
+* Determine the number of the block size
+*
+ LDTB = LTB/N
+ IF( LDTB .LT. 3*NB+1 ) THEN
+ NB = (LDTB-1)/3
+ END IF
+ IF( LWORK .LT. NB*N ) THEN
+ NB = LWORK/N
+ END IF
+*
+* Determine the number of the block columns
+*
+ NT = (N+NB-1)/NB
+ TD = 2*NB
+ KB = MIN(NB, N)
+*
+* Initialize vectors/matrices
+*
+ DO J = 1, KB
+ IPIV( J ) = J
+ END DO
+*
+* Save NB
+*
+ TB( 1 ) = NB
+*
+ IF( UPPER ) THEN
+*
+* .....................................................
+* Factorize A as L*D*L**T using the upper triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*U(I,J) + T(I+1,I)*U(I+1,J)
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ CONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( (I-1)*NB+1, J*NB+1 ), LDA,
+ $ CZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*U(I-1,J) + T(I,I)*U(I,J) + T(I,I+1)*U(I+1,J)
+ IF( I .EQ. (J-1) ) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ NB, KB, JB,
+ $ CONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (I-2)*NB+1, J*NB+1 ), LDA,
+ $ CZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL ZLACPY( 'Upper', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = U(1:J,J)'*H(1:J)
+ CALL ZGEMM( 'Transpose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -CONE, A( 1, J*NB+1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += U(J,J)'*T(J,J-1)*U(J-1,J)
+ CALL ZGEMM( 'Transpose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ CONE, A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ CZERO, WORK( 1 ), N )
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB,
+ $ -CONE, WORK( 1 ), N,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ $ = TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ IF( J.GT.0 ) THEN
+c CALL CHEGST( 1, 'Upper', KB,
+c $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+c $ A( (J-1)*NB+1, J*NB+1 ), LDA, IINFO )
+ CALL ZTRSM( 'L', 'U', 'T', 'N', KB, KB, CONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ CALL ZTRSM( 'R', 'U', 'N', 'N', KB, KB, CONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, KB,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ CZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, NB+KB,
+ $ CONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( (J-2)*NB+1, J*NB+1 ), LDA,
+ $ CZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL ZGEMM( 'Transpose', 'NoTranspose',
+ $ NB, N-(J+1)*NB, J*NB,
+ $ -CONE, WORK( NB+1 ), N,
+ $ A( 1, (J+1)*NB+1 ), LDA,
+ $ CONE, A( J*NB+1, (J+1)*NB+1 ), LDA )
+ END IF
+*
+* Copy panel to workspace to call ZGETRF
+*
+ DO K = 1, NB
+ CALL ZCOPY( N-(J+1)*NB,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA,
+ $ WORK( 1+(K-1)*N ), 1 )
+ END DO
+*
+* Factorize panel
+*
+ CALL ZGETRF( N-(J+1)*NB, NB,
+ $ WORK, N,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Copy panel back
+*
+ DO K = 1, NB
+ CALL ZCOPY( N-(J+1)*NB,
+ $ WORK( 1+(K-1)*N ), 1,
+ $ A( J*NB+K, (J+1)*NB+1 ), LDA )
+ END DO
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL ZLASET( 'Full', KB, NB, CZERO, CZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL ZLACPY( 'Upper', KB, NB,
+ $ WORK, N,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL ZTRSM( 'R', 'U', 'N', 'U', KB, NB, CONE,
+ $ A( (J-1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J,J+1) into T(J+1, J), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB )
+ $ = TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ CALL ZLASET( 'Lower', KB, NB, CZERO, CONE,
+ $ A( J*NB+1, (J+1)*NB+1), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL ZSWAP( K-1, A( (J+1)*NB+1, I1 ), 1,
+ $ A( (J+1)*NB+1, I2 ), 1 )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL ZSWAP( I2-I1-1, A( I1, I1+1 ), LDA,
+ $ A( I1+1, I2 ), 1 )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL ZSWAP( N-I2, A( I1, I2+1 ), LDA,
+ $ A( I2, I2+1 ), LDA )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL ZSWAP( J*NB, A( 1, I1 ), 1,
+ $ A( 1, I2 ), 1 )
+ END IF
+ ENDIF
+ END DO
+ END IF
+ END DO
+ ELSE
+*
+* .....................................................
+* Factorize A as L*D*L**T using the lower triangle of A
+* .....................................................
+*
+ DO J = 0, NT-1
+*
+* Generate Jth column of W and H
+*
+ KB = MIN(NB, N-J*NB)
+ DO I = 1, J-1
+ IF( I.EQ.1 ) THEN
+* H(I,J) = T(I,I)*L(J,I)' + T(I+1,I)'*L(J,I+1)'
+ IF( I .EQ. (J-1) ) THEN
+ JB = NB+KB
+ ELSE
+ JB = 2*NB
+ END IF
+ CALL ZGEMM( 'NoTranspose', 'Transpose',
+ $ NB, KB, JB,
+ $ CONE, TB( TD+1 + (I*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (I-1)*NB+1 ), LDA,
+ $ CZERO, WORK( I*NB+1 ), N )
+ ELSE
+* H(I,J) = T(I,I-1)*L(J,I-1)' + T(I,I)*L(J,I)' + T(I,I+1)*L(J,I+1)'
+ IF( I .EQ. (J-1) ) THEN
+ JB = 2*NB+KB
+ ELSE
+ JB = 3*NB
+ END IF
+ CALL ZGEMM( 'NoTranspose', 'Transpose',
+ $ NB, KB, JB,
+ $ CONE, TB( TD+NB+1 + ((I-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (I-2)*NB+1 ), LDA,
+ $ CZERO, WORK( I*NB+1 ), N )
+ END IF
+ END DO
+*
+* Compute T(J,J)
+*
+ CALL ZLACPY( 'Lower', KB, KB, A( J*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.1 ) THEN
+* T(J,J) = L(J,1:J)*H(1:J)
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, KB, (J-1)*NB,
+ $ -CONE, A( J*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+* T(J,J) += L(J,J)*T(J,J-1)*L(J,J-1)'
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ KB, NB, KB,
+ $ CONE, A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + ((J-1)*NB)*LDTB ), LDTB-1,
+ $ CZERO, WORK( 1 ), N )
+ CALL ZGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, NB,
+ $ -CONE, WORK( 1 ), N,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Expand T(J,J) into full format
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ $ = TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ END DO
+ END DO
+ IF( J.GT.0 ) THEN
+c CALL CHEGST( 1, 'Lower', KB,
+c $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+c $ A( J*NB+1, (J-1)*NB+1 ), LDA, IINFO )
+ CALL ZTRSM( 'L', 'L', 'N', 'N', KB, KB, CONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ CALL ZTRSM( 'R', 'L', 'T', 'N', KB, KB, CONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Symmetrize T(J,J)
+*
+ DO I = 1, KB
+ DO K = I+1, KB
+ TB( TD-(K-(I+1)) + (J*NB+K-1)*LDTB )
+ $ = TB( TD+(K-I)+1 + (J*NB+I-1)*LDTB )
+ END DO
+ END DO
+*
+ IF( J.LT.NT-1 ) THEN
+ IF( J.GT.0 ) THEN
+*
+* Compute H(J,J)
+*
+ IF( J.EQ.1 ) THEN
+ CALL ZGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, KB,
+ $ CONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ CZERO, WORK( J*NB+1 ), N )
+ ELSE
+ CALL ZGEMM( 'NoTranspose', 'Transpose',
+ $ KB, KB, NB+KB,
+ $ CONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ),
+ $ LDTB-1,
+ $ A( J*NB+1, (J-2)*NB+1 ), LDA,
+ $ CZERO, WORK( J*NB+1 ), N )
+ END IF
+*
+* Update with the previous column
+*
+ CALL ZGEMM( 'NoTranspose', 'NoTranspose',
+ $ N-(J+1)*NB, NB, J*NB,
+ $ -CONE, A( (J+1)*NB+1, 1 ), LDA,
+ $ WORK( NB+1 ), N,
+ $ CONE, A( (J+1)*NB+1, J*NB+1 ), LDA )
+ END IF
+*
+* Factorize panel
+*
+ CALL ZGETRF( N-(J+1)*NB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ IPIV( (J+1)*NB+1 ), IINFO )
+c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
+c INFO = IINFO+(J+1)*NB
+c END IF
+*
+* Compute T(J+1, J), zero out for GEMM update
+*
+ KB = MIN(NB, N-(J+1)*NB)
+ CALL ZLASET( 'Full', KB, NB, CZERO, CZERO,
+ $ TB( TD+NB+1 + (J*NB)*LDTB), LDTB-1 )
+ CALL ZLACPY( 'Upper', KB, NB,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ IF( J.GT.0 ) THEN
+ CALL ZTRSM( 'R', 'L', 'T', 'U', KB, NB, CONE,
+ $ A( J*NB+1, (J-1)*NB+1 ), LDA,
+ $ TB( TD+NB+1 + (J*NB)*LDTB ), LDTB-1 )
+ END IF
+*
+* Copy T(J+1,J) into T(J, J+1), both upper/lower for GEMM
+* updates
+*
+ DO K = 1, NB
+ DO I = 1, KB
+ TB( TD-NB+K-I+1 + (J*NB+NB+I-1)*LDTB ) =
+ $ TB( TD+NB+I-K+1 + (J*NB+K-1)*LDTB )
+ END DO
+ END DO
+ CALL ZLASET( 'Upper', KB, NB, CZERO, CONE,
+ $ A( (J+1)*NB+1, J*NB+1 ), LDA )
+*
+* Apply pivots to trailing submatrix of A
+*
+ DO K = 1, KB
+* > Adjust ipiv
+ IPIV( (J+1)*NB+K ) = IPIV( (J+1)*NB+K ) + (J+1)*NB
+*
+ I1 = (J+1)*NB+K
+ I2 = IPIV( (J+1)*NB+K )
+ IF( I1.NE.I2 ) THEN
+* > Apply pivots to previous columns of L
+ CALL ZSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA,
+ $ A( I2, (J+1)*NB+1 ), LDA )
+* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
+ CALL ZSWAP( I2-I1-1, A( I1+1, I1 ), 1,
+ $ A( I2, I1+1 ), LDA )
+* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
+ CALL ZSWAP( N-I2, A( I2+1, I1 ), 1,
+ $ A( I2+1, I2 ), 1 )
+* > Swap A(I1, I1) with A(I2, I2)
+ PIV = A( I1, I1 )
+ A( I1, I1 ) = A( I2, I2 )
+ A( I2, I2 ) = PIV
+* > Apply pivots to previous columns of L
+ IF( J.GT.0 ) THEN
+ CALL ZSWAP( J*NB, A( I1, 1 ), LDA,
+ $ A( I2, 1 ), LDA )
+ END IF
+ ENDIF
+ END DO
+*
+* Apply pivots to previous columns of L
+*
+c CALL ZLASWP( J*NB, A( 1, 1 ), LDA,
+c $ (J+1)*NB+1, (J+1)*NB+KB, IPIV, 1 )
+ END IF
+ END DO
+ END IF
+*
+* Factor the band matrix
+ CALL ZGBTRF( N, N, NB, NB, TB, LDTB, IPIV2, INFO )
+*
+* End of ZSYTRF_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16SYcomputational
*
* =====================================================================
SUBROUTINE ZSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL ZSYTRI, ZSYTRI2X
+ EXTERNAL ZSYTRI, ZSYTRI2X, XERBLA
* ..
* .. Executable Statements ..
*
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension (N+NNB+1,NNB+3)
+*> WORK is COMPLEX*16 array, dimension (N+NB+1,NB+3)
*> \endverbatim
*>
*> \param[in] NB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16SYcomputational
*
* =====================================================================
SUBROUTINE ZSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16SYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> November 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE ZSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, ILAENV
* ..
* .. External Subroutines ..
- EXTERNAL ZSYTRI_3X
+ EXTERNAL ZSYTRI_3X, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16SYcomputational
*
* ==================
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
SUBROUTINE ZSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16SYcomputational
*
*>
*> \verbatim
*>
-*> December 2016, Igor Kozachenko,
+*> June 2017, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
SUBROUTINE ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> of the matrix B. NRHS >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> Details of factors computed by ZSYTRF_AA.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16SYcomputational
*
SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL ZGTSV, ZSWAP, ZTRSM, XERBLA
+ EXTERNAL ZGTSV, ZSWAP, ZLACPY, ZTRSM, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX
--- /dev/null
+*> \brief \b ZSYTRS_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZSYTRS_AA_2STAGE + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytrs_aa_2stage.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytrs_aa_2stage.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytrs_aa_2stage.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
+* IPIV2, B, LDB, INFO )
+*
+* .. Scalar Arguments ..
+* CHARACTER UPLO
+* INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+* INTEGER IPIV( * ), IPIV2( * )
+* COMPLEX*16 A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZSYTRS_AA_2STAGE solves a system of linear equations A*X = B with a complex
+*> symmetric matrix A using the factorization A = U*T*U**T or
+*> A = L*T*L**T computed by ZSYTRF_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> Specifies whether the details of the factorization are stored
+*> as an upper or lower triangular matrix.
+*> = 'U': Upper triangular, form is A = U*T*U**T;
+*> = 'L': Lower triangular, form is A = L*T*L**T.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of columns
+*> of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> Details of factors computed by ZSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] TB
+*> \verbatim
+*> TB is COMPLEX*16 array, dimension (LTB)
+*> Details of factors computed by ZSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] LTB
+*> \verbatim
+*> The size of the array TB. LTB >= 4*N.
+*> \endverbatim
+*>
+*> \param[in] IPIV
+*> \verbatim
+*> IPIV is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> ZSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in] IPIV2
+*> \verbatim
+*> IPIV2 is INTEGER array, dimension (N)
+*> Details of the interchanges as computed by
+*> ZSYTRF_AA_2STAGE.
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (LDB,NRHS)
+*> On entry, the right hand side matrix B.
+*> On exit, the solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*> LDB is INTEGER
+*> The leading dimension of the array B. LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16SYcomputational
+*
+* =====================================================================
+ SUBROUTINE ZSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
+ $ IPIV, IPIV2, B, LDB, INFO )
+*
+* -- LAPACK computational routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER N, NRHS, LDA, LTB, LDB, INFO
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), IPIV2( * )
+ COMPLEX*16 A( LDA, * ), TB( * ), B( LDB, * )
+* ..
+*
+* =====================================================================
+*
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER LDTB, NB
+ LOGICAL UPPER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGBTRS, ZLASWP, ZTRSM, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LTB.LT.( 4*N ) ) THEN
+ INFO = -7
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -11
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZSYTRS_AA_2STAGE', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. NRHS.EQ.0 )
+ $ RETURN
+*
+* Read NB and compute LDTB
+*
+ NB = INT( TB( 1 ) )
+ LDTB = LTB/N
+*
+ IF( UPPER ) THEN
+*
+* Solve A*X = B, where A = U*T*U**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ]
+*
+ CALL ZTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (U**T \P**T * B) ]
+*
+ CALL ZGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ]
+*
+ CALL ZTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ]
+*
+ CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+*
+ ELSE
+*
+* Solve A*X = B, where A = L*T*L**T.
+*
+ IF( N.GT.NB ) THEN
+*
+* Pivot, P**T * B
+*
+ CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 )
+*
+* Compute (L \P**T * B) -> B [ (L \P**T * B) ]
+*
+ CALL ZTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+ END IF
+*
+* Compute T \ B -> B [ T \ (L \P**T * B) ]
+*
+ CALL ZGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB,
+ $ INFO)
+ IF( N.GT.NB ) THEN
+*
+* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
+*
+ CALL ZTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1),
+ $ LDA, B(NB+1, 1), LDB)
+*
+* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
+*
+ CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 )
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZSYTRS_AA_2STAGE
+*
+ END
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX*16 arrays, dimensions (LDA,N)
+*> A is COMPLEX*16 array, dimensions (LDA,N)
*> On entry, the matrix A in the pair (A, B).
*> On exit, the updated matrix A.
*> \endverbatim
*>
*> \param[in,out] B
*> \verbatim
-*> B is COMPLEX*16 arrays, dimensions (LDB,N)
+*> B is COMPLEX*16 array, dimensions (LDB,N)
*> On entry, the matrix B in the pair (A, B).
*> On exit, the updated matrix B.
*> \endverbatim
*>
*> \param[in,out] Q
*> \verbatim
-*> Q is COMPLEX*16 array, dimension (LDZ,N)
+*> Q is COMPLEX*16 array, dimension (LDQ,N)
*> If WANTQ = .TRUE, on entry, the unitary matrix Q. On exit,
*> the updated matrix Q.
*> Not referenced if WANTQ = .FALSE..
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEauxiliary
*
SUBROUTINE ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
$ LDZ, J1, INFO )
*
-* -- LAPACK auxiliary routine (version 3.7.0) --
+* -- LAPACK auxiliary routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL WANTQ, WANTZ
*>
*> \param[in,out] Q
*> \verbatim
-*> Q is COMPLEX*16 array, dimension (LDZ,N)
+*> Q is COMPLEX*16 array, dimension (LDQ,N)
*> On entry, if WANTQ = .TRUE., the unitary matrix Q.
*> On exit, the updated matrix Q.
*> If WANTQ = .FALSE., Q is not referenced.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16GEcomputational
*
SUBROUTINE ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
$ LDZ, IFST, ILST, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL WANTQ, WANTZ
*
*> \param[in] IJOB
*> \verbatim
-*> IJOB is integer
+*> IJOB is INTEGER
*> Specifies whether condition numbers are required for the
*> cluster of eigenvalues (PL and PR) or the deflating subspaces
*> (Difu and Difl):
$ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF,
$ WORK, LWORK, IWORK, LIWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* June 2016
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
-*> On entry, the lower triangular N-by-N matrix A.
+*> A is COMPLEX*16 array, dimension (LDA,M)
+*> On entry, the lower triangular M-by-M matrix A.
*> On exit, the elements on and below the diagonal of the array
*> contain the lower triangular matrix L.
*> \endverbatim
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[in,out] B
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*> C = [ A ] [ B ]
*>
*>
-*> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*> where A is an lower triangular M-by-M matrix, and B is M-by-N pentagonal
*> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L
*> upper trapezoidal matrix B2:
*> [ B ] = [ B1 ] [ B2 ]
*> [ B1 ] <- M-by-(N-L) rectangular
-*> [ B2 ] <- M-by-L upper trapezoidal.
+*> [ B2 ] <- M-by-L lower trapezoidal.
*>
*> The lower trapezoidal matrix B2 consists of the first L columns of a
-*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
+*> M-by-M lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0,
*> B is rectangular M-by-N; if M=L=N, B is lower triangular.
*>
*> The matrix W stores the elementary reflectors H(i) in the i-th row
*> above the diagonal (of A) in the M-by-(M+N) input matrix C
*> [ C ] = [ A ] [ B ]
-*> [ A ] <- lower triangular N-by-N
+*> [ A ] <- lower triangular M-by-M
*> [ B ] <- M-by-N pentagonal
*>
*> so that W can be represented as
*> [ W ] = [ I ] [ V ]
-*> [ I ] <- identity, N-by-N
+*> [ I ] <- identity, M-by-M
*> [ V ] <- M-by-N, same form as B.
*>
*> Thus, all of information needed for W is contained on exit in B, which
SUBROUTINE ZTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LDT, N, M, L, MB
*>
*> \param[in,out] A
*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,N)
+*> A is COMPLEX*16 array, dimension (LDA,M)
*> On entry, the lower triangular M-by-M matrix A.
*> On exit, the elements on and below the diagonal of the array
*> contain the lower triangular matrix L.
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
-*> The leading dimension of the array A. LDA >= max(1,N).
+*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
*> \param[in,out] B
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*> C = [ A ][ B ]
*>
*>
-*> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*> where A is an lower triangular M-by-M matrix, and B is M-by-N pentagonal
*> matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L
*> upper trapezoidal matrix B2:
*>
*> above the diagonal (of A) in the M-by-(M+N) input matrix C
*>
*> C = [ A ][ B ]
-*> [ A ] <- lower triangular N-by-N
+*> [ A ] <- lower triangular M-by-M
*> [ B ] <- M-by-N pentagonal
*>
*> so that W can be represented as
*>
*> W = [ I ][ V ]
-*> [ I ] <- identity, N-by-N
+*> [ I ] <- identity, M-by-M
*> [ V ] <- M-by-N, same form as B.
*>
*> Thus, all of information needed for W is contained on exit in B, which
* =====================================================================
SUBROUTINE ZTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDB, LDT, N, M, L
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
-*> Download DTPMQRT + dependencies
+*> Download ZTPMLQT + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztpmlqt.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztpmlqt.f">
*>
*> \verbatim
*>
-*> ZTPMQRT applies a complex orthogonal matrix Q obtained from a
-*> "triangular-pentagonal" real block reflector H to a general
-*> real matrix C, which consists of two blocks A and B.
+*> ZTPMLQT applies a complex orthogonal matrix Q obtained from a
+*> "triangular-pentagonal" complex block reflector H to a general
+*> complex matrix C, which consists of two blocks A and B.
*> \endverbatim
*
* Arguments:
*> \param[in] SIDE
*> \verbatim
*> SIDE is CHARACTER*1
-*> = 'L': apply Q or Q**C from the Left;
-*> = 'R': apply Q or Q**C from the Right.
+*> = 'L': apply Q or Q**H from the Left;
+*> = 'R': apply Q or Q**H from the Right.
*> \endverbatim
*>
*> \param[in] TRANS
*> \verbatim
*> TRANS is CHARACTER*1
*> = 'N': No transpose, apply Q;
-*> = 'C': Transpose, apply Q**C.
+*> = 'C': Transpose, apply Q**H.
*> \endverbatim
*>
*> \param[in] M
*> (LDA,K) if SIDE = 'R'
*> On entry, the K-by-N or M-by-K matrix A.
*> On exit, A is overwritten by the corresponding block of
-*> Q*C or Q**C*C or C*Q or C*Q**C. See Further Details.
+*> Q*C or Q**H*C or C*Q or C*Q**H. See Further Details.
*> \endverbatim
*>
*> \param[in] LDA
*> B is COMPLEX*16 array, dimension (LDB,N)
*> On entry, the M-by-N matrix B.
*> On exit, B is overwritten by the corresponding block of
-*> Q*C or Q**C*C or C*Q or C*Q**C. See Further Details.
+*> Q*C or Q**H*C or C*Q or C*Q**H. See Further Details.
*> \endverbatim
*>
*> \param[in] LDB
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup doubleOTHERcomputational
*
*>
*> If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
*>
-*> If TRANS='C' and SIDE='L', C is on exit replaced with Q**C * C.
+*> If TRANS='C' and SIDE='L', C is on exit replaced with Q**H * C.
*>
*> If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
*>
-*> If TRANS='C' and SIDE='R', C is on exit replaced with C * Q**C.
+*> If TRANS='C' and SIDE='R', C is on exit replaced with C * Q**H.
*> \endverbatim
*>
* =====================================================================
SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
$ A, LDA, B, LDB, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHERcomputational
*
SUBROUTINE ZTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
$ A, LDA, B, LDB, WORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
EXTERNAL LSAME
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA
+ EXTERNAL ZTPRFB, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHERcomputational
*
SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
$ LDVR, MM, M, WORK, RWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
EXTERNAL LSAME, IZAMAX, DLAMCH, DZASUM
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS
+ EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS, DLABAD
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
* @precisions fortran z -> c
*
$ LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
IMPLICIT NONE
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, SIDE
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS,
- $ ZGEMM, DLABAD, ZLASET
+ $ ZGEMM, DLABAD, ZLASET, ZLACPY
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DCMPLX, CONJG, AIMAG, MAX
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16OTHERcomputational
*
$ LDVR, S, SEP, MM, M, WORK, LDWORK, RWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER HOWMNY, JOB
EXTERNAL LSAME, IZAMAX, DLAMCH, DZNRM2, ZDOTC
* ..
* .. External Subroutines ..
- EXTERNAL XERBLA, ZDRSCL, ZLACN2, ZLACPY, ZLATRS, ZTREXC
+ EXTERNAL XERBLA, ZDRSCL, ZLACN2, ZLACPY, ZLATRS, ZTREXC,
+ $ DLABAD
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DIMAG, MAX
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
LOGICAL LQUERY
* ..
* .. External Subroutines ..
- EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, XERBLA
+ EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, ZLACGV,
+ $ XERBLA
* ..
* .. External Functions ..
DOUBLE PRECISION DZNRM2
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
$ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
LOGICAL LQUERY
* ..
* .. External Subroutines ..
- EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, XERBLA
+ EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZLACGV, XERBLA
* ..
* .. External Functions ..
DOUBLE PRECISION DZNRM2
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
$ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
LOGICAL LQUERY
* ..
* .. External Subroutines ..
- EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, XERBLA
+ EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, ZLACGV,
+ $ XERBLA
* ..
* .. External Functions ..
DOUBLE PRECISION DZNRM2
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE ZUNBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
$ LDQ2, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
SUBROUTINE ZUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2,
$ LDQ2, WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*>
*> \param[out] U1
*> \verbatim
-*> U1 is COMPLEX*16 array, dimension (P)
+*> U1 is COMPLEX*16 array, dimension (LDU1,P)
*> If JOBU1 = 'Y', U1 contains the P-by-P unitary matrix U1.
*> \endverbatim
*>
*>
*> \param[out] U2
*> \verbatim
-*> U2 is COMPLEX*16 array, dimension (M-P)
+*> U2 is COMPLEX*16 array, dimension (LDU2,M-P)
*> If JOBU2 = 'Y', U2 contains the (M-P)-by-(M-P) unitary
*> matrix U2.
*> \endverbatim
*>
*> \param[out] V1T
*> \verbatim
-*> V1T is COMPLEX*16 array, dimension (Q)
+*> V1T is COMPLEX*16 array, dimension (LDV1T,Q)
*> If JOBV1T = 'Y', V1T contains the Q-by-Q matrix unitary
*> matrix V1**H.
*> \endverbatim
*>
*> \param[out] V2T
*> \verbatim
-*> V2T is COMPLEX*16 array, dimension (M-Q)
+*> V2T is COMPLEX*16 array, dimension (LDV2T,M-Q)
*> If JOBV2T = 'Y', V2T contains the (M-Q)-by-(M-Q) unitary
*> matrix V2**H.
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16OTHERcomputational
*
$ LDV2T, WORK, LWORK, RWORK, LRWORK,
$ IWORK, INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, SIGNS, TRANS
*
*
*> \par Purpose:
-*> =============
+* =============
*>
*>\verbatim
*>
$ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK,
$ INFO )
*
-* -- LAPACK computational routine (version 3.7.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* July 2012
*> N2-by-N2 upper triangular matrix.
*> \endverbatim
*
-* Arguments
-* =========
+* Arguments:
+* ==========
*
*> \param[in] SIDE
*> \verbatim
SUBROUTINE ZUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC,
$ WORK, LWORK, INFO )
*
-* -- LAPACK computational routine (version 3.6.0) --
+* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* January 2015
# The test files are organized as follows:
#
# AEIGTST -- Auxiliary test routines used in all precisions
-# SCIGTST -- Auxiliary test routines used in REAL and COMPLEX
-# DZIGTST -- Auxiliary test routines used in DOUBLE PRECISION and
-# COMPLEX*16
+# SCIGTST -- Auxiliary test routines used in single precision
+# DZIGTST -- Auxiliary test routines used in double precision
# SEIGTST -- Single precision real test routines
# CEIGTST -- Single precision complex test routines
# DEIGTST -- Double precision real test routines
# ZEIGTST -- Double precision complex test routines
#
-# Test programs can be generated for all or some of the four different
-# precisions. Enter make followed by one or more of the data types
-# desired. Some examples:
-# make single
-# make single complex
-# make single double complex complex16
-# Alternatively, the command
-# make
-# without any arguments creates all four test programs.
-# The executable files are called
-# xeigtsts, xeigtstd, xeigtstc, and xeigtstz
-# and are created in the next higher directory level.
-#
-# To remove the object files after the executable files have been
-# created, enter
-# make clean
-# On some systems, you can force the source files to be recompiled by
-# entering (for example)
-# make single FRC=FRC
-#
########################################################################
set(AEIGTST
macro(add_eig_executable name)
add_executable(${name} ${ARGN})
- target_link_libraries(${name} tmglib ${LAPACK_LIBRARIES})
+ target_link_libraries(${name} tmglib ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
endmacro()
if(BUILD_SINGLE)
-add_eig_executable(xeigtsts ${SEIGTST} ${SCIGTST} ${AEIGTST}
- ${SECOND_SRC})
+add_eig_executable(xeigtsts ${SEIGTST} ${SCIGTST} ${AEIGTST})
endif()
if(BUILD_COMPLEX)
-add_eig_executable(xeigtstc ${CEIGTST} ${SCIGTST} ${AEIGTST}
- ${SECOND_SRC})
+add_eig_executable(xeigtstc ${CEIGTST} ${SCIGTST} ${AEIGTST})
endif()
if(BUILD_DOUBLE)
-add_eig_executable(xeigtstd ${DEIGTST} ${DZIGTST} ${AEIGTST}
- ${DSECOND_SRC})
+add_eig_executable(xeigtstd ${DEIGTST} ${DZIGTST} ${AEIGTST})
endif()
if(BUILD_COMPLEX16)
-add_eig_executable(xeigtstz ${ZEIGTST} ${DZIGTST} ${AEIGTST}
- ${DSECOND_SRC})
+add_eig_executable(xeigtstz ${ZEIGTST} ${DZIGTST} ${AEIGTST})
endif()
# The test files are organized as follows:
#
# AEIGTST -- Auxiliary test routines used in all precisions
-# SCIGTST -- Auxiliary test routines used in REAL and COMPLEX
-# DZIGTST -- Auxiliary test routines used in DOUBLE PRECISION and
-# COMPLEX*16
+# SCIGTST -- Auxiliary test routines used in single precision
+# DZIGTST -- Auxiliary test routines used in double precision
# SEIGTST -- Single precision real test routines
# CEIGTST -- Single precision complex test routines
# DEIGTST -- Double precision real test routines
# without any arguments creates all four test programs.
# The executable files are called
# xeigtsts, xeigtstd, xeigtstc, and xeigtstz
-# and are created in the next higher directory level.
#
# To remove the object files after the executable files have been
# created, enter
-# make clean
+# make cleanobj
# On some systems, you can force the source files to be recompiled by
# entering (for example)
# make single FRC=FRC
all: single complex double complex16
-single: ../xeigtsts
-complex: ../xeigtstc
-double: ../xeigtstd
-complex16: ../xeigtstz
+single: xeigtsts
+complex: xeigtstc
+double: xeigtstd
+complex16: xeigtstz
-../xeigtsts: $(SEIGTST) $(SCIGTST) $(AEIGTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ \
- $(SEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) \
- ../../$(LAPACKLIB) $(BLASLIB)
+xeigtsts: $(SEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xeigtstc: $(CEIGTST) $(SCIGTST) $(AEIGTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ \
- $(CEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) \
- ../../$(LAPACKLIB) $(BLASLIB)
+xeigtstc: $(CEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xeigtstd: $(DEIGTST) $(DZIGTST) $(AEIGTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ \
- $(DEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) \
- ../../$(LAPACKLIB) $(BLASLIB)
+xeigtstd: $(DEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xeigtstz: $(ZEIGTST) $(DZIGTST) $(AEIGTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ \
- $(ZEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) \
- ../../$(LAPACKLIB) $(BLASLIB)
+xeigtstz: $(ZEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
$(AEIGTST): $(FRC)
$(SCIGTST): $(FRC)
FRC:
@FRC=$(FRC)
-clean:
+clean: cleanobj cleanexe
+cleanobj:
rm -f *.o
+cleanexe:
+ rm -f xeigtst*
schkee.o: schkee.f
$(FORTRAN) $(DRVOPTS) -c -o $@ $<
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_eig
*
$ D2, D3, U, LDU, WORK, LWORK, RWORK, RESULT,
$ INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
* ..
* .. External Subroutines ..
EXTERNAL SLASUM, XERBLA, CHBT21, CHBTRD, CLACPY, CLASET,
- $ CLATMR, CLATMS, CHBTRD_HB2ST, CSTEQR
+ $ CLATMR, CLATMS, CHETRD_HB2ST, CSTEQR
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, REAL, CONJG, MAX, MIN, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_eig
*
$ LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK,
$ IWORK, LIWORK, RESULT, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
$ CHET22, CHPEV, CHPEVD, CHPEVX, CLACPY, CLASET,
$ CHEEVD_2STAGE, CHEEVR_2STAGE, CHEEVX_2STAGE,
$ CHEEV_2STAGE, CHBEV_2STAGE, CHBEVD_2STAGE,
- $ CHBEVX_2STAGE, CHETRD_2STAGE, CHETRD_SY2SB,
- $ CHETRD_SB2ST, CLATMR, CLATMS
+ $ CHBEVX_2STAGE, CLATMR, CLATMS
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, REAL, INT, LOG, MAX, MIN, SQRT
*> CHPEV, CHPEVX, CHPEVD, and CSTEDC.
*> CHEEVD_2STAGE, CHEEVR_2STAGE, CHEEVX_2STAGE,
*> CHEEV_2STAGE, CHBEV_2STAGE, CHBEVD_2STAGE,
-*> CHBEVX_2STAGE, CHETRD_2STAGE, CHETRD_SY2SB,
-*> CHETRD_SB2ST
+*> CHBEVX_2STAGE, CHETRD_2STAGE, CHETRD_HE2HB,
+*> CHETRD_HB2ST
*> \endverbatim
*
* Arguments:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_eig
*
* =====================================================================
SUBROUTINE CERRST( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
$ CUNGTR, CUNMTR, CUPGTR, CUPMTR,
$ CHEEVD_2STAGE, CHEEVR_2STAGE, CHEEVX_2STAGE,
$ CHEEV_2STAGE, CHBEV_2STAGE, CHBEVD_2STAGE,
- $ CHBEVX_2STAGE, CHETRD_2STAGE, CHETRD_SY2SB,
- $ CHETRD_SB2ST
+ $ CHBEVX_2STAGE, CHETRD_2STAGE, CHETRD_HE2HB,
+ $ CHETRD_HB2ST
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_eig
*
SUBROUTINE CGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
$ RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
COMPLEX CONE
- PARAMETER ( CONE = 1.0E+0 )
+ PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) )
* ..
* .. Local Scalars ..
INTEGER J, N1, N2
* Exit with RESID = 1/EPS if ANORM = 0.
*
EPS = SLAMCH( 'Epsilon' )
- ANORM = CLANGE( '1', N1, N2, A, LDA, RWORK )
+ ANORM = CLANGE( '1', M, N, A, LDA, RWORK )
IF( ANORM.LE.ZERO ) THEN
RESID = ONE / EPS
RETURN
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_eig
*
SUBROUTINE CLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
$ A, LDA, X, LDX, B, LDB, ISEED, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS, UPLO, XTYPE
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_eig
*
$ ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
$ D2, D3, U, LDU, WORK, LWORK, RESULT, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
* ..
* .. External Subroutines ..
EXTERNAL DLACPY, DLASET, DLASUM, DLATMR, DLATMS, DSBT21,
- $ DSBTRD, XERBLA, DSBTRD_SB2ST, DSTEQR
+ $ DSBTRD, XERBLA, DSYTRD_SB2ST, DSTEQR
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, MAX, MIN, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_eig
*
SUBROUTINE DGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
$ RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS
* Exit with RESID = 1/EPS if ANORM = 0.
*
EPS = DLAMCH( 'Epsilon' )
- ANORM = DLANGE( '1', N1, N2, A, LDA, RWORK )
+ ANORM = DLANGE( '1', M, N, A, LDA, RWORK )
IF( ANORM.LE.ZERO ) THEN
RESID = ONE / EPS
RETURN
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_eig
*
SUBROUTINE DLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
$ A, LDA, X, LDX, B, LDB, ISEED, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS, UPLO, XTYPE
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup OTHERauxiliary
*
INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
$ N4 )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*( * ) NAME, OPTS
* End of ILAENV
*
END
+ INTEGER FUNCTION ILAENV2STAGE( ISPEC, NAME, OPTS, N1, N2,
+ $ N3, N4 )
+* .. Scalar Arguments ..
+ CHARACTER*( * ) NAME, OPTS
+ INTEGER ISPEC, N1, N2, N3, N4
+* ..
+*
+* =====================================================================
+*
+* .. Local variables ..
+ INTEGER IISPEC
+* .. External Functions ..
+ INTEGER IPARAM2STAGE
+ EXTERNAL IPARAM2STAGE
+* ..
+* .. Arrays in Common ..
+ INTEGER IPARMS( 100 )
+* ..
+* .. Common blocks ..
+ COMMON / CLAENV / IPARMS
+* ..
+* .. Save statement ..
+ SAVE / CLAENV /
+* ..
+* .. Executable Statements ..
+*
+ IF(( ISPEC.GE.1 ) .AND. (ISPEC.LE.5)) THEN
+*
+* 1 <= ISPEC <= 5: 2stage eigenvalues SVD routines.
+*
+ IF( ISPEC.EQ.1 ) THEN
+ ILAENV2STAGE = IPARMS( 1 )
+ ELSE
+ IISPEC = 16 + ISPEC
+ ILAENV2STAGE = IPARAM2STAGE( IISPEC, NAME, OPTS,
+ $ N1, N2, N3, N4 )
+ ENDIF
+*
+ ELSE
+*
+* Invalid value for ISPEC
+*
+ ILAENV2STAGE = -1
+ END IF
+*
+ RETURN
+ END
INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK )
*
INTEGER INMIN, INWIN, INIBL, ISHFTS, IACC22
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup single_eig
*
$ ISEED, THRESH, NOUNIT, A, LDA, SD, SE, D1,
$ D2, D3, U, LDU, WORK, LWORK, RESULT, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
* ..
* .. External Subroutines ..
EXTERNAL SLACPY, SLASET, SLASUM, SLATMR, SLATMS, SSBT21,
- $ SSBTRD, XERBLA, SSBTRD_SB2ST, SSTEQR
+ $ SSBTRD, XERBLA, SSYTRD_SB2ST, SSTEQR
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, REAL, MAX, MIN, SQRT
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup single_eig
*
SUBROUTINE SGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
$ RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS
* Exit with RESID = 1/EPS if ANORM = 0.
*
EPS = SLAMCH( 'Epsilon' )
- ANORM = SLANGE( '1', N1, N2, A, LDA, RWORK )
+ ANORM = SLANGE( '1', M, N, A, LDA, RWORK )
IF( ANORM.LE.ZERO ) THEN
RESID = ONE / EPS
RETURN
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup single_eig
*
SUBROUTINE SLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
$ A, LDA, X, LDX, B, LDB, ISEED, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS, UPLO, XTYPE
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_eig
*
$ D2, D3, U, LDU, WORK, LWORK, RWORK, RESULT,
$ INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES,
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_eig
*
$ LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK,
$ IWORK, LIWORK, RESULT, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_eig
*
* =====================================================================
SUBROUTINE ZERRST( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_eig
*
SUBROUTINE ZGET02( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
$ RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
COMPLEX*16 CONE
- PARAMETER ( CONE = 1.0D+0 )
+ PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) )
* ..
* .. Local Scalars ..
INTEGER J, N1, N2
* Exit with RESID = 1/EPS if ANORM = 0.
*
EPS = DLAMCH( 'Epsilon' )
- ANORM = ZLANGE( '1', N1, N2, A, LDA, RWORK )
+ ANORM = ZLANGE( '1', M, N, A, LDA, RWORK )
IF( ANORM.LE.ZERO ) THEN
RESID = ONE / EPS
RETURN
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
-*> = 0: successful exit
-*> < 0: if INFO = -i, the i-th argument had an illegal value
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_eig
*
SUBROUTINE ZLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
$ A, LDA, X, LDX, B, LDB, ISEED, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS, UPLO, XTYPE
schkeq.f schkgb.f schkge.f schkgt.f
schklq.f schkpb.f schkpo.f schkps.f schkpp.f
schkpt.f schkq3.f schkql.f schkqr.f schkrq.f
- schksp.f schksy.f schksy_rook.f schksy_rk.f schksy_aa.f schktb.f schktp.f schktr.f
+ schksp.f schksy.f schksy_rook.f schksy_rk.f
+ schksy_aa.f schksy_aa_2stage.f
+ schktb.f schktp.f schktr.f
schktz.f
sdrvgt.f sdrvls.f sdrvpb.f
- sdrvpp.f sdrvpt.f sdrvsp.f sdrvsy.f sdrvsy_rook.f sdrvsy_rk.f sdrvsy_aa.f
+ sdrvpp.f sdrvpt.f sdrvsp.f sdrvsy_rook.f sdrvsy_rk.f
+ sdrvsy_aa.f sdrvsy_aa_2stage.f
serrgt.f serrlq.f serrls.f
- serrpo.f serrps.f serrql.f serrqp.f serrqr.f
- serrrq.f serrsy.f serrtr.f serrtz.f serrvx.f
+ serrps.f serrql.f serrqp.f serrqr.f
+ serrrq.f serrtr.f serrtz.f
sgbt01.f sgbt02.f sgbt05.f sgelqs.f sgeqls.f sgeqrs.f
sgerqs.f sget01.f sget02.f
sget03.f sget04.f sget06.f sget07.f sgtt01.f sgtt02.f
sqrt01.f sqrt01p.f sqrt02.f sqrt03.f sqrt11.f sqrt12.f
sqrt13.f sqrt14.f sqrt15.f sqrt16.f sqrt17.f
srqt01.f srqt02.f srqt03.f srzt01.f srzt02.f
- sspt01.f ssyt01.f ssyt01_rook.f ssyt01_3.f ssyt01_aa.f
+ sspt01.f ssyt01.f ssyt01_rook.f ssyt01_3.f
+ ssyt01_aa.f
stbt02.f stbt03.f stbt05.f stbt06.f stpt01.f
stpt02.f stpt03.f stpt05.f stpt06.f strt01.f
strt02.f strt03.f strt05.f strt06.f
- sgennd.f
- sqrt04.f sqrt05.f schkqrt.f serrqrt.f schkqrtp.f serrqrtp.f
+ sgennd.f sqrt04.f sqrt05.f schkqrt.f serrqrt.f schkqrtp.f serrqrtp.f
schklqt.f schklqtp.f schktsqr.f
serrlqt.f serrlqtp.f serrtsqr.f stsqr01.f slqt04.f slqt05.f)
-if(USEXBLAS)
- list(APPEND SLINTST sdrvgex.f serrgex.f sdrvgbx.f sdrvpox.f sebchvxx.f)
+if(USE_XBLAS)
+ list(APPEND SLINTST sdrvgbx.f sdrvgex.f sdrvsyx.f sdrvpox.f
+ serrvxx.f serrgex.f serrsyx.f serrpox.f
+ sebchvxx.f)
else()
- list(APPEND SLINTST sdrvge.f serrge.f sdrvgb.f sdrvpo.f)
+ list(APPEND SLINTST sdrvgb.f sdrvge.f sdrvsy.f sdrvpo.f
+ serrvx.f serrge.f serrsy.f serrpo.f)
endif()
set(CLINTST cchkaa.f
cchkeq.f cchkgb.f cchkge.f cchkgt.f
- cchkhe.f cchkhe_rook.f cchkhe_rk.f cchkhe_aa.f cchkhp.f cchklq.f cchkpb.f
+ cchkhe.f cchkhe_rook.f cchkhe_rk.f
+ cchkhe_aa.f cchkhe_aa_2stage.f
+ cchkhp.f cchklq.f cchkpb.f
cchkpo.f cchkps.f cchkpp.f cchkpt.f cchkq3.f cchkql.f
- cchkqr.f cchkrq.f cchksp.f cchksy.f cchksy_rook.f cchksy_rk.f cchksy_aa.f cchktb.f
+ cchkqr.f cchkrq.f cchksp.f cchksy.f cchksy_rook.f cchksy_rk.f
+ cchksy_aa.f cchksy_aa_2stage.f
+ cchktb.f
cchktp.f cchktr.f cchktz.f
- cdrvgt.f cdrvhe.f cdrvhe_rook.f cdrvhe_rk.f cdrvhe_aa.f cdrvhp.f
+ cdrvgt.f cdrvhe_rook.f cdrvhe_rk.f
+ cdrvhe_aa.f cdrvhe_aa_2stage.f cdrvsy_aa_2stage.f
+ cdrvhp.f
cdrvls.f cdrvpb.f cdrvpp.f cdrvpt.f
- cdrvsp.f cdrvsy.f cdrvsy_rook.f cdrvsy_rk.f cdrvsy_aa.f
- cerrgt.f cerrhe.f cerrlq.f
+ cdrvsp.f cdrvsy_rook.f cdrvsy_rk.f
+ cdrvsy_aa.f
+ cerrgt.f cerrlq.f
cerrls.f cerrps.f cerrql.f cerrqp.f
- cerrqr.f cerrrq.f cerrsy.f cerrtr.f cerrtz.f
- cerrvx.f
+ cerrqr.f cerrrq.f cerrtr.f cerrtz.f
cgbt01.f cgbt02.f cgbt05.f cgelqs.f cgeqls.f cgeqrs.f
cgerqs.f cget01.f cget02.f
cget03.f cget04.f cget07.f cgtt01.f cgtt02.f
- cgtt05.f chet01.f chet01_rook.f chet01_3.f chet01_aa.f
+ cgtt05.f chet01.f chet01_rook.f chet01_3.f
+ chet01_aa.f
chpt01.f claipd.f claptm.f clarhs.f clatb4.f clatb5.f
clatsp.f clatsy.f clattb.f clattp.f clattr.f
clavhe.f clavhe_rook.f clavhp.f clavsp.f clavsy.f clavsy_rook.f clqt01.f
cqrt12.f cqrt13.f cqrt14.f cqrt15.f cqrt16.f
cqrt17.f crqt01.f crqt02.f crqt03.f crzt01.f crzt02.f
csbmv.f cspt01.f
- cspt02.f cspt03.f csyt01.f csyt01_rook.f csyt01_3.f csyt01_aa.f csyt02.f csyt03.f
+ cspt02.f cspt03.f csyt01.f csyt01_rook.f csyt01_3.f
+ csyt01_aa.f
+ csyt02.f csyt03.f
ctbt02.f ctbt03.f ctbt05.f ctbt06.f ctpt01.f
ctpt02.f ctpt03.f ctpt05.f ctpt06.f ctrt01.f
ctrt02.f ctrt03.f ctrt05.f ctrt06.f
cchklqt.f cchklqtp.f cchktsqr.f
cerrlqt.f cerrlqtp.f cerrtsqr.f ctsqr01.f clqt04.f clqt05.f)
-if(USEXBLAS)
- list(APPEND
- CLINTST cdrvgex.f cdrvgbx.f cerrgex.f cdrvpox.f cerrpox.f cebchvxx.f)
+if(USE_XBLAS)
+ list(APPEND CLINTST cdrvgbx.f cdrvgex.f cdrvhex.f cdrvsyx.f cdrvpox.f
+ cerrvxx.f cerrgex.f cerrhex.f cerrsyx.f cerrpox.f
+ cebchvxx.f)
else()
- list(APPEND CLINTST cdrvge.f cdrvgb.f cerrge.f cdrvpo.f cerrpo.f)
+ list(APPEND CLINTST cdrvgb.f cdrvge.f cdrvhe.f cdrvsy.f cdrvpo.f
+ cerrvx.f cerrge.f cerrhe.f cerrsy.f cerrpo.f)
endif()
set(DLINTST dchkaa.f
dchkeq.f dchkgb.f dchkge.f dchkgt.f
dchklq.f dchkpb.f dchkpo.f dchkps.f dchkpp.f
dchkpt.f dchkq3.f dchkql.f dchkqr.f dchkrq.f
- dchksp.f dchksy.f dchksy_rook.f dchksy_rk.f dchksy_aa.f dchktb.f dchktp.f dchktr.f
+ dchksp.f dchksy.f dchksy_rook.f dchksy_rk.f
+ dchksy_aa.f dchksy_aa_2stage.f
+ dchktb.f dchktp.f dchktr.f
dchktz.f
ddrvgt.f ddrvls.f ddrvpb.f
- ddrvpp.f ddrvpt.f ddrvsp.f ddrvsy.f ddrvsy_rook.f ddrvsy_rk.f ddrvsy_aa.f
+ ddrvpp.f ddrvpt.f ddrvsp.f ddrvsy_rook.f ddrvsy_rk.f
+ ddrvsy_aa.f ddrvsy_aa_2stage.f
derrgt.f derrlq.f derrls.f
derrps.f derrql.f derrqp.f derrqr.f
- derrrq.f derrsy.f derrtr.f derrtz.f derrvx.f
+ derrrq.f derrtr.f derrtz.f
dgbt01.f dgbt02.f dgbt05.f dgelqs.f dgeqls.f dgeqrs.f
dgerqs.f dget01.f dget02.f
dget03.f dget04.f dget06.f dget07.f dgtt01.f dgtt02.f
dqrt01.f dqrt01p.f dqrt02.f dqrt03.f dqrt11.f dqrt12.f
dqrt13.f dqrt14.f dqrt15.f dqrt16.f dqrt17.f
drqt01.f drqt02.f drqt03.f drzt01.f drzt02.f
- dspt01.f dsyt01.f dsyt01_rook.f dsyt01_3.f dsyt01_aa.f
+ dspt01.f dsyt01.f dsyt01_rook.f dsyt01_3.f
+ dsyt01_aa.f
dtbt02.f dtbt03.f dtbt05.f dtbt06.f dtpt01.f
dtpt02.f dtpt03.f dtpt05.f dtpt06.f dtrt01.f
dtrt02.f dtrt03.f dtrt05.f dtrt06.f
dchklq.f dchklqt.f dchklqtp.f dchktsqr.f
derrlqt.f derrlqtp.f derrtsqr.f dtsqr01.f dlqt04.f dlqt05.f)
-if(USEXBLAS)
- list(APPEND
- DLINTST ddrvgex.f ddrvgbx.f derrgex.f ddrvpox.f derrpox.f debchvxx.f)
+if(USE_XBLAS)
+ list(APPEND DLINTST ddrvgbx.f ddrvgex.f ddrvsyx.f ddrvpox.f
+ derrvxx.f derrgex.f derrsyx.f derrpox.f
+ debchvxx.f)
else()
- list(APPEND
- DLINTST ddrvge.f ddrvgb.f derrge.f ddrvpo.f derrpo.f)
+ list(APPEND DLINTST ddrvgb.f ddrvge.f ddrvsy.f ddrvpo.f
+ derrvx.f derrge.f derrsy.f derrpo.f)
endif()
set(ZLINTST zchkaa.f
zchkeq.f zchkgb.f zchkge.f zchkgt.f
- zchkhe.f zchkhe_rook.f zchkhe_rk.f zchkhe_aa.f zchkhp.f zchklq.f zchkpb.f
+ zchkhe.f zchkhe_rook.f zchkhe_rk.f
+ zchkhe_aa.f zchkhe_aa_2stage.f
+ zchkhp.f zchklq.f zchkpb.f
zchkpo.f zchkps.f zchkpp.f zchkpt.f zchkq3.f zchkql.f
- zchkqr.f zchkrq.f zchksp.f zchksy.f zchksy_rook.f zchksy_rk.f zchksy_aa.f zchktb.f
+ zchkqr.f zchkrq.f zchksp.f zchksy.f zchksy_rook.f zchksy_rk.f
+ zchksy_aa.f zchksy_aa_2stage.f
+ zchktb.f
zchktp.f zchktr.f zchktz.f
- zdrvgt.f zdrvhe.f zdrvhe_rook.f zdrvhe_rk.f zdrvhe_aa.f zdrvhp.f
+ zdrvgt.f zdrvhe_rook.f zdrvhe_rk.f
+ zdrvhe_aa.f zdrvhe_aa_2stage.f
+ zdrvhp.f
zdrvls.f zdrvpb.f zdrvpp.f zdrvpt.f
- zdrvsp.f zdrvsy.f zdrvsy_rook.f zdrvsy_rk.f zdrvsy_aa.f
- zerrgt.f zerrhe.f zerrlq.f
+ zdrvsp.f zdrvsy_rook.f zdrvsy_rk.f
+ zdrvsy_aa.f zdrvsy_aa_2stage.f
+ zerrgt.f zerrlq.f
zerrls.f zerrps.f zerrql.f zerrqp.f
- zerrqr.f zerrrq.f zerrsy.f zerrtr.f zerrtz.f
- zerrvx.f
+ zerrqr.f zerrrq.f zerrtr.f zerrtz.f
zgbt01.f zgbt02.f zgbt05.f zgelqs.f zgeqls.f zgeqrs.f
zgerqs.f zget01.f zget02.f
zget03.f zget04.f zget07.f zgtt01.f zgtt02.f
- zgtt05.f zhet01.f zhet01_rook.f zhet01_3.f zhet01_aa.f
+ zgtt05.f zhet01.f zhet01_rook.f zhet01_3.f
+ zhet01_aa.f
zhpt01.f zlaipd.f zlaptm.f zlarhs.f zlatb4.f zlatb5.f
zlatsp.f zlatsy.f zlattb.f zlattp.f zlattr.f
zlavhe.f zlavhe_rook.f zlavhp.f zlavsp.f zlavsy.f zlavsy_rook.f zlqt01.f
zqrt12.f zqrt13.f zqrt14.f zqrt15.f zqrt16.f
zqrt17.f zrqt01.f zrqt02.f zrqt03.f zrzt01.f zrzt02.f
zsbmv.f zspt01.f
- zspt02.f zspt03.f zsyt01.f zsyt01_rook.f zsyt01_3.f zsyt01_aa.f zsyt02.f zsyt03.f
+ zspt02.f zspt03.f zsyt01.f zsyt01_rook.f zsyt01_3.f
+ zsyt01_aa.f
+ zsyt02.f zsyt03.f
ztbt02.f ztbt03.f ztbt05.f ztbt06.f ztpt01.f
ztpt02.f ztpt03.f ztpt05.f ztpt06.f ztrt01.f
ztrt02.f ztrt03.f ztrt05.f ztrt06.f
zchklqt.f zchklqtp.f zchktsqr.f
zerrlqt.f zerrlqtp.f zerrtsqr.f ztsqr01.f zlqt04.f zlqt05.f)
-if(USEXBLAS)
- list(APPEND
- ZLINTST zdrvgex.f zdrvgbx.f zerrgex.f zdrvpox.f zerrpox.f zebchvxx.f)
+if(USE_XBLAS)
+ list(APPEND ZLINTST zdrvgbx.f zdrvgex.f zdrvhex.f zdrvsyx.f zdrvpox.f
+ zerrvxx.f zerrgex.f zerrhex.f zerrsyx.f zerrpox.f
+ zebchvxx.f)
else()
- list(APPEND
- ZLINTST zdrvge.f zdrvgb.f zerrge.f zdrvpo.f zerrpo.f)
+ list(APPEND ZLINTST zdrvgb.f zdrvge.f zdrvhe.f zdrvsy.f zdrvpo.f
+ zerrvx.f zerrge.f zerrhe.f zerrsy.f zerrpo.f)
endif()
set(DSLINTST dchkab.f
macro(add_lin_executable name)
add_executable(${name} ${ARGN})
- target_link_libraries(${name} tmglib ${LAPACK_LIBRARIES})
+ target_link_libraries(${name} tmglib ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
endmacro()
if(BUILD_SINGLE)
- add_lin_executable(xlintsts ${ALINTST} ${SCLNTST} ${SLINTST} ${SECOND_SRC})
- add_lin_executable(xlintstrfs ${SLINTSTRFP} ${SECOND_SRC})
+ add_lin_executable(xlintsts ${ALINTST} ${SLINTST} ${SCLNTST})
+ add_lin_executable(xlintstrfs ${SLINTSTRFP})
endif()
if(BUILD_DOUBLE)
- add_lin_executable(xlintstd ${ALINTST} ${DLINTST} ${DZLNTST} ${DSECOND_SRC})
- add_lin_executable(xlintstrfd ${DLINTSTRFP} ${DSECOND_SRC})
+ add_lin_executable(xlintstd ${ALINTST} ${DLINTST} ${DZLNTST})
+ add_lin_executable(xlintstrfd ${DLINTSTRFP})
endif()
if(BUILD_SINGLE AND BUILD_DOUBLE)
- add_lin_executable(xlintstds ${DSLINTST} ${SECOND_SRC} ${DSECOND_SRC})
+ add_lin_executable(xlintstds ${DSLINTST})
endif()
if(BUILD_COMPLEX)
- add_lin_executable(xlintstc ${ALINTST} ${CLINTST} ${SCLNTST} ${SECOND_SRC})
- add_lin_executable(xlintstrfc ${CLINTSTRFP} ${SECOND_SRC})
+ add_lin_executable(xlintstc ${ALINTST} ${CLINTST} ${SCLNTST})
+ add_lin_executable(xlintstrfc ${CLINTSTRFP})
endif()
if(BUILD_COMPLEX16)
- add_lin_executable(xlintstz ${ALINTST} ${ZLINTST} ${DZLNTST} ${DSECOND_SRC})
- add_lin_executable(xlintstrfz ${ZLINTSTRFP} ${DSECOND_SRC})
+ add_lin_executable(xlintstz ${ALINTST} ${ZLINTST} ${DZLNTST})
+ add_lin_executable(xlintstrfz ${ZLINTSTRFP})
endif()
if(BUILD_COMPLEX AND BUILD_COMPLEX16)
- add_lin_executable(xlintstzc ${ZCLINTST} ${SECOND_SRC} ${DSECOND_SRC})
+ add_lin_executable(xlintstzc ${ZCLINTST})
endif()
# ALINTST -- Auxiliary test routines
# SLINTST -- Single precision real test routines
# CLINTST -- Single precision complex test routines
-# SCLNTST -- Single and Complex routines in common
+# SCLNTST -- Single precision real and complex routines in common
# DLINTST -- Double precision real test routines
# ZLINTST -- Double precision complex test routines
-# DZLNTST -- Double and Double Complex routines in common
+# DZLNTST -- Double precision real and complex routines in common
#
# Test programs can be generated for all or some of the four different
# precisions. Enter make followed by one or more of the data types
# make
# without any arguments creates all four test programs.
# The executable files are called
-# xlintims, xlintimd, xlintimc, and xlintimz
-# and are created in the next higher directory level.
+# xlintsts, xlintstd, xlintstc, and xlintstz
#
# To remove the object files after the executable files have been
# created, enter
-# make clean
+# make cleanobj
# On some systems, you can force the source files to be recompiled by
# entering (for example)
# make single FRC=FRC
schkeq.o schkgb.o schkge.o schkgt.o \
schklq.o schkpb.o schkpo.o schkps.o schkpp.o \
schkpt.o schkq3.o schkql.o schkqr.o schkrq.o \
- schksp.o schksy.o schksy_rook.o schksy_rk.o schksy_aa.o schktb.o schktp.o schktr.o \
+ schksp.o schksy.o schksy_rook.o schksy_rk.o \
+ schksy_aa.o schksy_aa_2stage.o schktb.o schktp.o schktr.o \
schktz.o \
sdrvgt.o sdrvls.o sdrvpb.o \
- sdrvpp.o sdrvpt.o sdrvsp.o sdrvsy_rook.o sdrvsy_rk.o sdrvsy_aa.o \
+ sdrvpp.o sdrvpt.o sdrvsp.o sdrvsy_rook.o sdrvsy_rk.o \
+ sdrvsy_aa.o sdrvsy_aa_2stage.o \
serrgt.o serrlq.o serrls.o \
serrps.o serrql.o serrqp.o serrqr.o \
serrrq.o serrtr.o serrtz.o \
serrlqt.o serrlqtp.o serrtsqr.o stsqr01.o slqt04.o slqt05.o
ifdef USEXBLAS
-SLINTST += serrvxx.o sdrvgex.o sdrvsyx.o serrgex.o sdrvgbx.o sdrvpox.o \
- sebchvxx.o serrsyx.o serrpox.o
+SLINTST += sdrvgbx.o sdrvgex.o sdrvsyx.o sdrvpox.o \
+ serrvxx.o serrgex.o serrsyx.o serrpox.o \
+ sebchvxx.o
else
-SLINTST += serrvx.o sdrvge.o sdrvsy.o serrge.o sdrvgb.o sdrvpo.o \
- serrsy.o serrpo.o
+SLINTST += sdrvgb.o sdrvge.o sdrvsy.o sdrvpo.o \
+ serrvx.o serrge.o serrsy.o serrpo.o
endif
CLINTST = cchkaa.o \
cchkeq.o cchkgb.o cchkge.o cchkgt.o \
- cchkhe.o cchkhe_rook.o cchkhe_rk.o cchkhe_aa.o cchkhp.o cchklq.o cchkpb.o \
+ cchkhe.o cchkhe_rook.o cchkhe_rk.o \
+ cchkhe_aa.o cchkhe_aa_2stage.o cchkhp.o cchklq.o cchkpb.o \
cchkpo.o cchkps.o cchkpp.o cchkpt.o cchkq3.o cchkql.o \
- cchkqr.o cchkrq.o cchksp.o cchksy.o cchksy_rook.o cchksy_rk.o cchksy_aa.o cchktb.o \
+ cchkqr.o cchkrq.o cchksp.o cchksy.o cchksy_rook.o cchksy_rk.o \
+ cchksy_aa.o cchksy_aa_2stage.o cchktb.o \
cchktp.o cchktr.o cchktz.o \
cdrvgt.o cdrvhe_rook.o cdrvhe_rk.o cdrvhe_aa.o cdrvhp.o \
+ cdrvhe_aa_2stage.o \
cdrvls.o cdrvpb.o cdrvpp.o cdrvpt.o \
- cdrvsp.o cdrvsy_rook.o cdrvsy_rk.o cdrvsy_aa.o \
+ cdrvsp.o cdrvsy_rook.o cdrvsy_rk.o cdrvsy_aa.o cdrvsy_aa_2stage.o \
cerrgt.o cerrlq.o \
cerrls.o cerrps.o cerrql.o cerrqp.o \
cerrqr.o cerrrq.o cerrtr.o cerrtz.o \
cgbt01.o cgbt02.o cgbt05.o cgelqs.o cgeqls.o cgeqrs.o \
cgerqs.o cget01.o cget02.o \
cget03.o cget04.o cget07.o cgtt01.o cgtt02.o \
- cgtt05.o chet01.o chet01_rook.o chet01_3.o \
- chet01_aa.o chpt01.o claipd.o claptm.o clarhs.o clatb4.o clatb5.o \
+ cgtt05.o chet01.o chet01_rook.o chet01_3.o chet01_aa.o \
+ chpt01.o claipd.o claptm.o clarhs.o clatb4.o clatb5.o \
clatsp.o clatsy.o clattb.o clattp.o clattr.o \
clavhe.o clavhe_rook.o clavhp.o clavsp.o clavsy.o clavsy_rook.o clqt01.o \
clqt02.o clqt03.o cpbt01.o cpbt02.o cpbt05.o \
cerrlqt.o cerrlqtp.o cerrtsqr.o ctsqr01.o clqt04.o clqt05.o
ifdef USEXBLAS
-CLINTST += cerrvxx.o cdrvgex.o cdrvsyx.o cdrvgbx.o cerrgex.o cdrvpox.o \
- cdrvhex.o cerrpox.o cebchvxx.o cerrsyx.o cerrhex.o
+CLINTST += cdrvgbx.o cdrvgex.o cdrvhex.o cdrvsyx.o cdrvpox.o \
+ cerrvxx.o cerrgex.o cerrhex.o cerrsyx.o cerrpox.o \
+ cebchvxx.o
else
-CLINTST += cerrvx.o cdrvge.o cdrvsy.o cdrvgb.o cerrge.o cdrvpo.o \
- cdrvhe.o cerrpo.o cerrsy.o cerrhe.o
+CLINTST += cdrvgb.o cdrvge.o cdrvhe.o cdrvsy.o cdrvpo.o \
+ cerrvx.o cerrge.o cerrhe.o cerrsy.o cerrpo.o
endif
DLINTST = dchkaa.o \
dchkeq.o dchkgb.o dchkge.o dchkgt.o \
dchklq.o dchkpb.o dchkpo.o dchkps.o dchkpp.o \
dchkpt.o dchkq3.o dchkql.o dchkqr.o dchkrq.o \
- dchksp.o dchksy.o dchksy_rook.o dchksy_rk.o dchksy_aa.o dchktb.o dchktp.o dchktr.o \
+ dchksp.o dchksy.o dchksy_rook.o dchksy_rk.o \
+ dchksy_aa.o dchksy_aa_2stage.o dchktb.o dchktp.o dchktr.o \
dchktz.o \
ddrvgt.o ddrvls.o ddrvpb.o \
- ddrvpp.o ddrvpt.o ddrvsp.o ddrvsy_rook.o ddrvsy_rk.o ddrvsy_aa.o \
+ ddrvpp.o ddrvpt.o ddrvsp.o ddrvsy_rook.o ddrvsy_rk.o \
+ ddrvsy_aa.o ddrvsy_aa_2stage.o \
derrgt.o derrlq.o derrls.o \
derrps.o derrql.o derrqp.o derrqr.o \
derrrq.o derrtr.o derrtz.o \
derrlqt.o derrlqtp.o derrtsqr.o dtsqr01.o dlqt04.o dlqt05.o
ifdef USEXBLAS
-DLINTST += derrvxx.o ddrvgex.o ddrvsyx.o ddrvgbx.o derrgex.o ddrvpox.o derrpox.o \
- debchvxx.o derrsyx.o
+DLINTST += ddrvgbx.o ddrvgex.o ddrvsyx.o ddrvpox.o \
+ derrvxx.o derrgex.o derrsyx.o derrpox.o \
+ debchvxx.o
else
-DLINTST += derrvx.o ddrvge.o ddrvsy.o ddrvgb.o derrge.o ddrvpo.o derrpo.o \
- derrsy.o
+DLINTST += ddrvgb.o ddrvge.o ddrvsy.o ddrvpo.o \
+ derrvx.o derrge.o derrsy.o derrpo.o
endif
ZLINTST = zchkaa.o \
zchkeq.o zchkgb.o zchkge.o zchkgt.o \
- zchkhe.o zchkhe_rook.o zchkhe_rk.o zchkhe_aa.o zchkhp.o zchklq.o zchkpb.o \
+ zchkhe.o zchkhe_rook.o zchkhe_rk.o zchkhe_aa.o zchkhe_aa_2stage.o \
+ zchkhp.o zchklq.o zchkpb.o \
zchkpo.o zchkps.o zchkpp.o zchkpt.o zchkq3.o zchkql.o \
- zchkqr.o zchkrq.o zchksp.o zchksy.o zchksy_rook.o zchksy_rk.o zchksy_aa.o zchktb.o \
+ zchkqr.o zchkrq.o zchksp.o zchksy.o zchksy_rook.o zchksy_rk.o \
+ zchksy_aa.o zchksy_aa_2stage.o zchktb.o \
zchktp.o zchktr.o zchktz.o \
- zdrvgt.o zdrvhe_rook.o zdrvhe_rk.o zdrvhe_aa.o zdrvhp.o \
+ zdrvgt.o zdrvhe_rook.o zdrvhe_rk.o zdrvhe_aa.o zdrvhe_aa_2stage.o zdrvhp.o \
zdrvls.o zdrvpb.o zdrvpp.o zdrvpt.o \
- zdrvsp.o zdrvsy_rook.o zdrvsy_rk.o zdrvsy_aa.o \
+ zdrvsp.o zdrvsy_rook.o zdrvsy_rk.o zdrvsy_aa.o zdrvsy_aa_2stage.o \
zerrgt.o zerrlq.o \
zerrls.o zerrps.o zerrql.o zerrqp.o \
zerrqr.o zerrrq.o zerrtr.o zerrtz.o \
zgbt01.o zgbt02.o zgbt05.o zgelqs.o zgeqls.o zgeqrs.o \
zgerqs.o zget01.o zget02.o \
zget03.o zget04.o zget07.o zgtt01.o zgtt02.o \
- zgtt05.o zhet01.o zhet01_rook.o zhet01_3.o \
- zhet01_aa.o zhpt01.o zlaipd.o zlaptm.o zlarhs.o zlatb4.o zlatb5.o \
+ zgtt05.o zhet01.o zhet01_rook.o zhet01_3.o zhet01_aa.o \
+ zhpt01.o zlaipd.o zlaptm.o zlarhs.o zlatb4.o zlatb5.o \
zlatsp.o zlatsy.o zlattb.o zlattp.o zlattr.o \
zlavhe.o zlavhe_rook.o zlavhp.o zlavsp.o zlavsy.o zlavsy_rook.o zlqt01.o \
zlqt02.o zlqt03.o zpbt01.o zpbt02.o zpbt05.o \
zerrlqt.o zerrlqtp.o zerrtsqr.o ztsqr01.o zlqt04.o zlqt05.o
ifdef USEXBLAS
-ZLINTST += zerrvxx.o zdrvgex.o zdrvsyx.o zdrvgbx.o zerrgex.o zdrvpox.o zdrvhex.o \
- zerrpox.o zebchvxx.o zerrsyx.o zerrhex.o
+ZLINTST += zdrvgbx.o zdrvgex.o zdrvhex.o zdrvsyx.o zdrvpox.o \
+ zerrvxx.o zerrgex.o zerrhex.o zerrsyx.o zerrpox.o \
+ zebchvxx.o
else
-ZLINTST += zerrvx.o zdrvge.o zdrvsy.o zdrvgb.o zerrge.o zdrvpo.o \
- zdrvhe.o zerrpo.o zerrsy.o zerrhe.o
+ZLINTST += zdrvgb.o zdrvge.o zdrvhe.o zdrvsy.o zdrvpo.o \
+ zerrvx.o zerrge.o zerrhe.o zerrsy.o zerrpo.o
endif
DSLINTST = dchkab.o \
all: single double complex complex16 proto-single proto-double proto-complex proto-complex16
-single: ../xlintsts
-double: ../xlintstd
-complex: ../xlintstc
-complex16: ../xlintstz
+single: xlintsts
+double: xlintstd
+complex: xlintstc
+complex16: xlintstz
-proto-single: ../xlintstrfs
-proto-double: ../xlintstds ../xlintstrfd
-proto-complex: ../xlintstrfc
-proto-complex16: ../xlintstzc ../xlintstrfz
+proto-single: xlintstrfs
+proto-double: xlintstds xlintstrfd
+proto-complex: xlintstrfc
+proto-complex16: xlintstzc xlintstrfz
-../xlintsts: $(ALINTST) $(SLINTST) $(SCLNTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $(ALINTST) $(SCLNTST) $(SLINTST) \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
+xlintsts: $(ALINTST) $(SLINTST) $(SCLNTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xlintstc: $(ALINTST) $(CLINTST) $(SCLNTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $(ALINTST) $(SCLNTST) $(CLINTST) \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
+xlintstc: $(ALINTST) $(CLINTST) $(SCLNTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xlintstd: $(ALINTST) $(DLINTST) $(DZLNTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $^ \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
+xlintstd: $(ALINTST) $(DLINTST) $(DZLNTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xlintstz: $(ALINTST) $(ZLINTST) $(DZLNTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $(ALINTST) $(DZLNTST) $(ZLINTST) \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
+xlintstz: $(ALINTST) $(ZLINTST) $(DZLNTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xlintstds: $(DSLINTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $(DSLINTST) \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+xlintstds: $(DSLINTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xlintstzc: $(ZCLINTST) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $(ZCLINTST) \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+xlintstzc: $(ZCLINTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xlintstrfs: $(SLINTSTRFP) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $(SLINTSTRFP) \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+xlintstrfs: $(SLINTSTRFP) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xlintstrfd: $(DLINTSTRFP) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $(DLINTSTRFP) \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+xlintstrfd: $(DLINTSTRFP) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xlintstrfc: $(CLINTSTRFP) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $(CLINTSTRFP) \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+xlintstrfc: $(CLINTSTRFP) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
-../xlintstrfz: $(ZLINTSTRFP) ../../$(LAPACKLIB)
- $(LOADER) $(LOADOPTS) -o $@ $(ZLINTSTRFP) \
- ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+xlintstrfz: $(ZLINTSTRFP) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB)
+ $(LOADER) $(LOADOPTS) -o $@ $^
$(ALINTST): $(FRC)
$(SCLNTST): $(FRC)
FRC:
@FRC=$(FRC)
-clean:
+clean: cleanobj cleanexe
+cleanobj:
rm -f *.o
+cleanexe:
+ rm -f xlintst*
schkaa.o: schkaa.f
$(FORTRAN) $(DRVOPTS) -c -o $@ $<
*> CHR 10 List types on next line if 0 < NTYPES < 10
*> CHK 10 List types on next line if 0 < NTYPES < 10
*> CHA 10 List types on next line if 0 < NTYPES < 10
+*> CH2 10 List types on next line if 0 < NTYPES < 10
+*> CSA 11 List types on next line if 0 < NTYPES < 10
+*> CS2 11 List types on next line if 0 < NTYPES < 10
*> CHP 10 List types on next line if 0 < NTYPES < 10
*> CSY 11 List types on next line if 0 < NTYPES < 11
*> CSK 11 List types on next line if 0 < NTYPES < 11
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_lin
*
* =====================================================================
PROGRAM CCHKAA
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* =====================================================================
*
*
IF( TSTCHK ) THEN
CALL CCHKHE_AA( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
- $ NSVAL, THRESH, TSTERR, LDA,
+ $ NSVAL, THRESH, TSTERR, LDA,
+ $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9989 )PATH
+ END IF
+*
+ IF( TSTDRV ) THEN
+ CALL CDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9988 )PATH
+ END IF
+*
+ ELSE IF( LSAMEN( 2, C2, 'H2' ) ) THEN
+*
+* H2: Hermitian matrices,
+* with partial (Aasen's) pivoting algorithm
+*
+ NTYPES = 10
+ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+ IF( TSTCHK ) THEN
+ CALL CCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB2, NBVAL2,
+ $ NNS, NSVAL, THRESH, TSTERR, LDA,
$ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
$ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
$ WORK, RWORK, IWORK, NOUT )
END IF
*
IF( TSTDRV ) THEN
- CALL CDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ CALL CDRVHE_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
$ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
$ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
$ WORK, RWORK, IWORK, NOUT )
WRITE( NOUT, FMT = 9988 )PATH
END IF
*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* S2: symmetric indefinite matrices with Aasen's algorithm
+* 2 stage
+*
+ NTYPES = 11
+ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+ IF( TSTCHK ) THEN
+ CALL CCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
+ $ NSVAL, THRESH, TSTERR, LDA,
+ $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9989 )PATH
+ END IF
+*
+ IF( TSTDRV ) THEN
+ CALL CDRVSY_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+ $ RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9988 )PATH
+ END IF
+*
ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
*
* SP: symmetric indefinite packed matrices,
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*
*> \ingroup complex_lin
$ THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
$ X, XACT, WORK, RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
INTEGER ISEED( 4 ), ISEEDY( 4 )
REAL RESULT( NTESTS )
* ..
-* .. External Functions ..
- REAL DGET06, CLANHE
- EXTERNAL DGET06, CLANHE
-* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, CERRHE, CGET04,
- $ ZHECON, CHERFS, CHET01_AA, CHETRF_AA, ZHETRI2,
- $ CHETRS_AA, CLACPY, CLAIPD, CLARHS, CLATB4,
- $ CLATMS, CPOT02, ZPOT03, ZPOT05
+ EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, CERRHE, CHET01_AA,
+ $ CHETRF_AA, CHETRS_AA, CLACPY, CLAIPD, CLARHS,
+ $ CLATB4, CLATMS, CPOT02
* ..
* .. Intrinsic Functions ..
- INTRINSIC REAL, IMAG, MAX, MIN
+ INTRINSIC MAX, MIN
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
* Adjust the expected value of INFO to account for
* pivoting.
*
- IF( IZERO.GT.0 ) THEN
- J = 1
- K = IZERO
- 100 CONTINUE
- IF( J.EQ.K ) THEN
- K = IWORK( J )
- ELSE IF( IWORK( J ).EQ.K ) THEN
- K = J
- END IF
- IF( J.LT.K ) THEN
- J = J + 1
- GO TO 100
- END IF
- ELSE
+c IF( IZERO.GT.0 ) THEN
+c J = 1
+c K = IZERO
+c 100 CONTINUE
+c IF( J.EQ.K ) THEN
+c K = IWORK( J )
+c ELSE IF( IWORK( J ).EQ.K ) THEN
+c K = J
+c END IF
+c IF( J.LT.K ) THEN
+c J = J + 1
+c GO TO 100
+c END IF
+c ELSE
K = 0
- END IF
+c END IF
*
* Check error code from CHETRF and handle error.
*
* Check error code from CHETRS and handle error.
*
IF( INFO.NE.0 ) THEN
- CALL ALAERH( PATH, 'CHETRS_AA', INFO, 0,
- $ UPLO, N, N, -1, -1, NRHS, IMAT,
- $ NFAIL, NERRS, NOUT )
- END IF
-*
- CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
-*
-* Compute the residual for the solution
-*
- CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
- $ LDA, RWORK, RESULT( 2 ) )
-*
-* Print information about the tests that did not pass
-* the threshold.
-*
- DO 120 K = 2, 2
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
- $ IMAT, K, RESULT( K )
- NFAIL = NFAIL + 1
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'CHETRS_AA', INFO, 0,
+ $ UPLO, N, N, -1, -1, NRHS, IMAT,
+ $ NFAIL, NERRS, NOUT )
END IF
- 120 CONTINUE
+ ELSE
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
+*
+* Compute the residual for the solution
+*
+ CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
NRUN = NRUN + 1
*
* End do for each value of NRHS in NSVAL.
--- /dev/null
+*> \brief \b CCHKHE_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL,
+* NNS, NSVAL, THRESH, TSTERR, NMAX, A,
+* AFAC, AINV, B, X, XACT, WORK, RWORK,
+* IWORK, NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NN, NNB, NNS, NOUT
+* REAL THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+* REAL RWORK( * )
+* COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CCHKSY_AA_2STAGE tests CHETRF_AA_2STAGE, -TRS_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*> NNB is INTEGER
+*> The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*> NBVAL is INTEGER array, dimension (NBVAL)
+*> The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*> NNS is INTEGER
+*> The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*> NSVAL is INTEGER array, dimension (NNS)
+*> The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is REAL
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX array, dimension (NMAX*NSMAX)
+*> where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is REAL array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*
+*> \ingroup complex_lin
+*
+* =====================================================================
+ SUBROUTINE CCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS,
+ $ NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV,
+ $ B, X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NN, NNB, NNS, NMAX, NOUT
+ REAL THRESH
+* ..
+* .. Array Arguments ..
+*
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+ REAL RWORK( * )
+ COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E+0 )
+ COMPLEX CZERO
+ PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+ INTEGER NTYPES
+ PARAMETER ( NTYPES = 10 )
+ INTEGER NTESTS
+ PARAMETER ( NTESTS = 9 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, TYPE, UPLO, XTYPE
+ CHARACTER*3 PATH, MATPATH
+ INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+ $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+ $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+ REAL ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ REAL RESULT( NTESTS )
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALAERH, ALAHD, ALASUM, CERRHE, CLACPY,
+ $ CLARHS, CLATB4, CLATMS, CPOT02,
+ $ CHETRF_AA_2STAGE,
+ $ CHETRS_AA_2STAGE, XLAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Complex precision'
+ PATH( 2: 3 ) = 'H2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Complex precision'
+ MATPATH( 2: 3 ) = 'HE'
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL CERRHE( PATH, NOUT )
+ INFOT = 0
+*
+* Set the minimum block size for which the block routine should
+* be used, which will be later returned by ILAENV
+*
+ CALL XLAENV( 2, 2 )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ IF( N .GT. NMAX ) THEN
+ NFAIL = NFAIL + 1
+ WRITE(NOUT, 9995) 'M ', N, NMAX
+ GO TO 180
+ END IF
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ IZERO = 0
+*
+* Do for each value of matrix type IMAT
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+*
+* Set up parameters with CLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+ $ ANORM, MODE, CNDNUM, DIST )
+*
+* Generate a matrix with CLATMS.
+*
+ SRNAMT = 'CLATMS'
+ CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from CLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+* Skip all tests for this generated matrix
+*
+ GO TO 160
+ END IF
+*
+* For matrix types 3-6, zero one or more rows and
+* columns of the matrix to test that INFO is returned
+* correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate test matrix A.
+*
+*
+* Set the imaginary part of the diagonals.
+*
+ CALL CLAIPD( N, A, LDA+1, 0 )
+*
+* Do for each value of NB in NBVAL
+*
+ DO 150 INB = 1, NNB
+*
+* Set the optimal blocksize, which will be later
+* returned by ILAENV.
+*
+ NB = NBVAL( INB )
+ CALL XLAENV( 1, NB )
+*
+* Copy the test matrix A into matrix AFAC which
+* will be factorized in place. This is needed to
+* preserve the test matrix A for subsequent tests.
+*
+ CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+* Compute the L*D*L**T or U*D*U**T factorization of the
+* matrix. IWORK stores details of the interchanges and
+* the block structure of D. AINV is a work array for
+* block factorization, LWORK is the length of AINV.
+*
+ SRNAMT = 'CHETRF_AA_2STAGE'
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL CHETRF_AA_2STAGE( UPLO, N, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ WORK, LWORK,
+ $ INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from CHETRF and handle error.
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'CHETRF_AA_2STAGE', INFO, K,
+ $ UPLO, N, N, -1, -1, NB, IMAT, NFAIL,
+ $ NERRS, NOUT )
+ END IF
+*
+*+ TEST 1
+* Reconstruct matrix from factors and compute residual.
+*
+*
+c NEED TO WRITE CHET01_AA_2STAGE
+c CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+c $ AINV, LDA, RWORK, RESULT( 1 ) )
+c NT = 1
+ NT = 0
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+ $ RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+*
+* Skip solver test if INFO is not 0.
+*
+ IF( INFO.NE.0 ) THEN
+ GO TO 140
+ END IF
+*
+* Do for each value of NRHS in NSVAL.
+*
+ DO 130 IRHS = 1, NNS
+ NRHS = NSVAL( IRHS )
+*
+*+ TEST 2 (Using TRS)
+* Solve and compute residual for A * X = B.
+*
+* Choose a set of NRHS random solution vectors
+* stored in XACT and set up the right hand side B
+*
+ SRNAMT = 'CLARHS'
+ CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+ $ KL, KU, NRHS, A, LDA, XACT, LDA,
+ $ B, LDA, ISEED, INFO )
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+ SRNAMT = 'CHETRS_AA_2STAGE'
+ LWORK = MAX( 1, 3*N-2 )
+ CALL CHETRS_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N, IWORK, IWORK( 1+N ),
+ $ X, LDA, INFO )
+*
+* Check error code from CHETRS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'CHETRS_AA_2STAGE',
+ $ INFO, 0, UPLO, N, N, -1, -1,
+ $ NRHS, IMAT, NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
+*
+* Compute the residual for the solution
+*
+ CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
+ NRUN = NRUN + 1
+*
+* End do for each value of NRHS in NSVAL.
+*
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+ $ I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+ $ I6 )
+ RETURN
+*
+* End of CCHKSY_AA_2STAGE
+*
+ END
* =====================================================================
PROGRAM CCHKRFP
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
STOP
END IF
*
- IF( FATAL ) THEN
- WRITE( NOUT, FMT = 9999 )
- STOP
- END IF
-*
* Calculate and print the machine dependent constants.
*
EPS = SLAMCH( 'Underflow threshold' )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
* @generated from LIN/dchksy_aa.f, fortran d -> c, Wed Nov 16 21:34:18 2016
*
$ THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
$ X, XACT, WORK, RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
INTEGER ISEED( 4 ), ISEEDY( 4 )
REAL RESULT( NTESTS )
* ..
-* .. External Functions ..
- REAL DGET06, CLANSY
- EXTERNAL DGET06, CLANSY
-* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, CERRSY, CGET04, CLACPY,
- $ CLARHS, CLATB4, CLATMS, CSYT02, DSYT03, DSYT05,
- $ DSYCON, CSYRFS, CSYT01_AA, CSYTRF_AA,
- $ DSYTRI2, CSYTRS_AA, XLAENV
+ EXTERNAL ALAERH, ALAHD, ALASUM, CERRSY, CLACPY, CLARHS,
+ $ CLATB4, CLATMS, CSYT02, CSYT01_AA, CSYTRF_AA,
+ $ CSYTRS_AA, XLAENV
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* Adjust the expected value of INFO to account for
* pivoting.
*
- IF( IZERO.GT.0 ) THEN
- J = 1
- K = IZERO
- 100 CONTINUE
- IF( J.EQ.K ) THEN
- K = IWORK( J )
- ELSE IF( IWORK( J ).EQ.K ) THEN
- K = J
- END IF
- IF( J.LT.K ) THEN
- J = J + 1
- GO TO 100
- END IF
- ELSE
+c IF( IZERO.GT.0 ) THEN
+c J = 1
+c K = IZERO
+c 100 CONTINUE
+c IF( J.EQ.K ) THEN
+c K = IWORK( J )
+c ELSE IF( IWORK( J ).EQ.K ) THEN
+c K = J
+c END IF
+c IF( J.LT.K ) THEN
+c J = J + 1
+c GO TO 100
+c END IF
+c ELSE
K = 0
- END IF
+c END IF
*
* Check error code from CSYTRF and handle error.
*
* Check error code from CSYTRS and handle error.
*
IF( INFO.NE.0 ) THEN
- CALL ALAERH( PATH, 'CSYTRS_AA', INFO, 0,
- $ UPLO, N, N, -1, -1, NRHS, IMAT,
- $ NFAIL, NERRS, NOUT )
- END IF
-*
- CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'CSYTRS_AA', INFO, 0,
+ $ UPLO, N, N, -1, -1, NRHS, IMAT,
+ $ NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
*
-* Compute the residual for the solution
+* Compute the residual for the solution
*
- CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
- $ LDA, RWORK, RESULT( 2 ) )
+ CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
*
*
-* Print information about the tests that did not pass
-* the threshold.
+* Print information about the tests that did not pass
+* the threshold.
*
- DO 120 K = 2, 2
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
- $ IMAT, K, RESULT( K )
- NFAIL = NFAIL + 1
- END IF
- 120 CONTINUE
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
NRUN = NRUN + 1
*
* End do for each value of NRHS in NSVAL.
--- /dev/null
+*> \brief \b CCHKSY_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL,
+* NNS, NSVAL, THRESH, TSTERR, NMAX, A,
+* AFAC, AINV, B, X, XACT, WORK, RWORK,
+* IWORK, NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NNB, NNS, NOUT
+* REAL THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+* REAL RWORK( * )
+* COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CCHKSY_AA_2STAGE tests CSYTRF_AA_2STAGE, -TRS_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*> NNB is INTEGER
+*> The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*> NBVAL is INTEGER array, dimension (NBVAL)
+*> The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*> NNS is INTEGER
+*> The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*> NSVAL is INTEGER array, dimension (NNS)
+*> The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is REAL
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX array, dimension (NMAX*NSMAX)
+*> where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is COMPLEX array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex_lin
+*
+* =====================================================================
+ SUBROUTINE CCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS,
+ $ NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV,
+ $ B, X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NN, NNB, NNS, NMAX, NOUT
+ REAL THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+ COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+ REAL RWORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX CZERO
+ PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+ INTEGER NTYPES
+ PARAMETER ( NTYPES = 10 )
+ INTEGER NTESTS
+ PARAMETER ( NTESTS = 9 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, TYPE, UPLO, XTYPE
+ CHARACTER*3 PATH, MATPATH
+ INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+ $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+ $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+ REAL ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ REAL RESULT( NTESTS )
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALAERH, ALAHD, ALASUM, CERRSY, CLACPY, CLARHS,
+ $ CLATB4, CLATMS, CSYT02, CSYT01,
+ $ CSYTRF_AA_2STAGE, CSYTRS_AA_2STAGE,
+ $ XLAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Complex precision'
+ PATH( 2: 3 ) = 'S2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Complex precision'
+ MATPATH( 2: 3 ) = 'SY'
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL CERRSY( PATH, NOUT )
+ INFOT = 0
+*
+* Set the minimum block size for which the block routine should
+* be used, which will be later returned by ILAENV
+*
+ CALL XLAENV( 2, 2 )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ IF( N .GT. NMAX ) THEN
+ NFAIL = NFAIL + 1
+ WRITE(NOUT, 9995) 'M ', N, NMAX
+ GO TO 180
+ END IF
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ IZERO = 0
+*
+* Do for each value of matrix type IMAT
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+*
+* Set up parameters with CLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+ $ ANORM, MODE, CNDNUM, DIST )
+*
+* Generate a matrix with CLATMS.
+*
+ SRNAMT = 'CLATMS'
+ CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from CLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+* Skip all tests for this generated matrix
+*
+ GO TO 160
+ END IF
+*
+* For matrix types 3-6, zero one or more rows and
+* columns of the matrix to test that INFO is returned
+* correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+* Do for each value of NB in NBVAL
+*
+ DO 150 INB = 1, NNB
+*
+* Set the optimal blocksize, which will be later
+* returned by ILAENV.
+*
+ NB = NBVAL( INB )
+ CALL XLAENV( 1, NB )
+*
+* Copy the test matrix A into matrix AFAC which
+* will be factorized in place. This is needed to
+* preserve the test matrix A for subsequent tests.
+*
+ CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+* Compute the L*D*L**T or U*D*U**T factorization of the
+* matrix. IWORK stores details of the interchanges and
+* the block structure of D. AINV is a work array for
+* block factorization, LWORK is the length of AINV.
+*
+ SRNAMT = 'CSYTRF_AA_2STAGE'
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL CSYTRF_AA_2STAGE( UPLO, N, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ WORK, LWORK,
+ $ INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from CSYTRF and handle error.
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'CSYTRF_AA_2STAGE', INFO, K,
+ $ UPLO, N, N, -1, -1, NB, IMAT, NFAIL,
+ $ NERRS, NOUT )
+ END IF
+*
+*+ TEST 1
+* Reconstruct matrix from factors and compute residual.
+*
+c CALL CSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+c $ AINV, LDA, RWORK, RESULT( 1 ) )
+c NT = 1
+ NT = 0
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+ $ RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+*
+* Skip solver test if INFO is not 0.
+*
+ IF( INFO.NE.0 ) THEN
+ GO TO 140
+ END IF
+*
+* Do for each value of NRHS in NSVAL.
+*
+ DO 130 IRHS = 1, NNS
+ NRHS = NSVAL( IRHS )
+*
+*+ TEST 2 (Using TRS)
+* Solve and compute residual for A * X = B.
+*
+* Choose a set of NRHS random solution vectors
+* stored in XACT and set up the right hand side B
+*
+ SRNAMT = 'CLARHS'
+ CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+ $ KL, KU, NRHS, A, LDA, XACT, LDA,
+ $ B, LDA, ISEED, INFO )
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+ SRNAMT = 'CSYTRS_AA_2STAGE'
+ LWORK = MAX( 1, 3*N-2 )
+ CALL CSYTRS_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N, IWORK, IWORK( 1+N ),
+ $ X, LDA, INFO )
+*
+* Check error code from CSYTRS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'CSYTRS_AA_2STAGE',
+ $ INFO, 0, UPLO, N, N, -1, -1,
+ $ NRHS, IMAT, NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
+*
+* Compute the residual for the solution
+*
+ CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
+ NRUN = NRUN + 1
+*
+* End do for each value of NRHS in NSVAL.
+*
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+ $ I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+ $ I6 )
+ RETURN
+*
+* End of CCHKSY_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_lin
*
$ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
$ RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
DO 10 I = 1, 4
ISEED( I ) = ISEEDY( I )
10 CONTINUE
- LWORK = MAX( 2*NMAX, NMAX*NRHS )
*
* Test the error exits
*
*
DO 180 IN = 1, NN
N = NVAL( IN )
+ LWORK = MAX( 3*N-2, N*(1+NB) )
+ LWORK = MAX( LWORK, 1 )
LDA = MAX( N, 1 )
XTYPE = 'N'
NIMAT = NTYPES
--- /dev/null
+*> \brief \b CDRVHE_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CDRVHE_AA_2STAGE(
+* DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+* NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NOUT, NRHS
+* REAL THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NVAL( * )
+* REAL RWORK( * )
+* COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CDRVHE_AA_2STAGE tests the driver routine CHESV_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand side vectors to be generated for
+*> each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is REAL
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is REAL array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex_lin
+*
+* =====================================================================
+ SUBROUTINE CDRVHE_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+ $ RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NMAX, NN, NOUT, NRHS
+ REAL THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NVAL( * )
+ REAL RWORK( * )
+ COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+ INTEGER NTYPES, NTESTS
+ PARAMETER ( NTYPES = 10, NTESTS = 3 )
+ INTEGER NFACT
+ PARAMETER ( NFACT = 2 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
+ CHARACTER*3 MATPATH, PATH
+ INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+ $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+ $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+ REAL ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER FACTS( NFACT ), UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ REAL RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ REAL CLANHE, SGET06
+ EXTERNAL CLANHE, SGET06
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, CERRVX,
+ $ CGET04, CLACPY, CLARHS, CLATB4, CLATMS,
+ $ CHESV_AA_2STAGE, CPOT02,
+ $ CHETRF_AA_2STAGE
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CMPLX, MAX, MIN
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Complex precision'
+ PATH( 2: 3 ) = 'H2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Complex precision'
+ MATPATH( 2: 3 ) = 'HE'
+*
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL CERRVX( PATH, NOUT )
+ INFOT = 0
+*
+* Set the block size and minimum block size for testing.
+*
+ NB = 1
+ NBMIN = 2
+ CALL XLAENV( 1, NB )
+ CALL XLAENV( 2, NBMIN )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+* Set up parameters with CLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+ $ MODE, CNDNUM, DIST )
+*
+* Generate a matrix with CLATMS.
+*
+ SRNAMT = 'CLATMS'
+ CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+ $ WORK, INFO )
+*
+* Check error code from CLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
+ $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+ GO TO 160
+ END IF
+*
+* For types 3-6, zero one or more rows and columns of
+* the matrix to test that INFO is returned correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = ZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = ZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IOFF = 0
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = ZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = ZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+*
+ DO 150 IFACT = 1, NFACT
+*
+* Do first for FACT = 'F', then for other values.
+*
+ FACT = FACTS( IFACT )
+*
+* Form an exact solution and set the right hand side.
+*
+ SRNAMT = 'CLARHS'
+ CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+ $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+ $ INFO )
+ XTYPE = 'C'
+*
+* --- Test CHESV_AA_2STAGE ---
+*
+ IF( IFACT.EQ.2 ) THEN
+ CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+* Factor the matrix and solve the system using CHESV_AA.
+*
+ SRNAMT = 'CHESV_AA_2STAGE '
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL CHESV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ X, LDA, WORK, LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from CHESV_AA .
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'CHESV_AA', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
+ $ IMAT, NFAIL, NERRS, NOUT )
+ GO TO 120
+ ELSE IF( INFO.NE.0 ) THEN
+ GO TO 120
+ END IF
+*
+* Compute residual of the computed solution.
+*
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 1 ) )
+*
+* Reconstruct matrix from factors and compute
+* residual.
+*
+c CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA,
+c $ IWORK, AINV, LDA, RWORK,
+c $ RESULT( 2 ) )
+c NT = 2
+ NT = 1
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALADHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )'CHESV_AA ',
+ $ UPLO, N, IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+ 120 CONTINUE
+ END IF
+*
+ 150 CONTINUE
+*
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+ $ ', test ', I2, ', ratio =', G12.5 )
+ RETURN
+*
+* End of CDRVHE_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_lin
*
$ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B,
$ COPYB, C, S, COPYS, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
REAL EPS, NORMA, NORMB, RCOND
* ..
* .. Local Arrays ..
- INTEGER ISEED( 4 ), ISEEDY( 4 ), IWORKQUERY
- REAL RESULT( NTESTS ), RWORKQUERY
- COMPLEX WORKQUERY
+ INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ
+ REAL RESULT( NTESTS ), RWQ
+ COMPLEX WQ
* ..
* .. Allocatable Arrays ..
COMPLEX, ALLOCATABLE :: WORK (:)
M = MMAX
N = NMAX
NRHS = NSMAX
- LDA = MAX( 1, M )
- LDB = MAX( 1, M, N )
MNMIN = MAX( MIN( M, N ), 1 )
*
* Compute workspace needed for routines
* CQRT14, CQRT17 (two side cases), CQRT15 and CQRT12
*
- LWORK = MAX( ( M+N )*NRHS,
+ LWORK = MAX( 1, ( M+N )*NRHS,
$ ( N+NRHS )*( M+2 ), ( M+NRHS )*( N+2 ),
$ MAX( M+MNMIN, NRHS*MNMIN,2*N+M ),
$ MAX( M*N+4*MNMIN+MAX(M,N), M*N+2*MNMIN+4*N ) )
+ LRWORK = 1
+ LIWORK = 1
+*
+* Iterate through all test cases and compute necessary workspace
+* sizes for ?GELS, ?GETSLS, ?GELSY, ?GELSS and ?GELSD routines.
+*
+ DO IM = 1, NM
+ M = MVAL( IM )
+ LDA = MAX( 1, M )
+ DO IN = 1, NN
+ N = NVAL( IN )
+ MNMIN = MAX(MIN( M, N ),1)
+ LDB = MAX( 1, M, N )
+ DO INS = 1, NNS
+ NRHS = NSVAL( INS )
+ DO IRANK = 1, 2
+ DO ISCALE = 1, 3
+ ITYPE = ( IRANK-1 )*3 + ISCALE
+ IF( DOTYPE( ITYPE ) ) THEN
+ IF( IRANK.EQ.1 ) THEN
+ DO ITRAN = 1, 2
+ IF( ITRAN.EQ.1 ) THEN
+ TRANS = 'N'
+ ELSE
+ TRANS = 'C'
+ END IF
+*
+* Compute workspace needed for CGELS
+ CALL CGELS( TRANS, M, N, NRHS, A, LDA,
+ $ B, LDB, WQ, -1, INFO )
+ LWORK_CGELS = INT( WQ )
+* Compute workspace needed for CGETSLS
+ CALL CGETSLS( TRANS, M, N, NRHS, A, LDA,
+ $ B, LDB, WQ, -1, INFO )
+ LWORK_CGETSLS = INT( WQ )
+ ENDDO
+ END IF
+* Compute workspace needed for CGELSY
+ CALL CGELSY( M, N, NRHS, A, LDA, B, LDB,
+ $ IWQ, RCOND, CRANK, WQ, -1, RWORK,
+ $ INFO )
+ LWORK_CGELSY = INT( WQ )
+ LRWORK_CGELSY = 2*N
+* Compute workspace needed for CGELSS
+ CALL CGELSS( M, N, NRHS, A, LDA, B, LDB, S,
+ $ RCOND, CRANK, WQ, -1, RWORK, INFO )
+ LWORK_CGELSS = INT( WQ )
+ LRWORK_CGELSS = 5*MNMIN
+* Compute workspace needed for CGELSD
+ CALL CGELSD( M, N, NRHS, A, LDA, B, LDB, S,
+ $ RCOND, CRANK, WQ, -1, RWQ, IWQ,
+ $ INFO )
+ LWORK_CGELSD = INT( WQ )
+ LRWORK_CGELSD = INT( RWQ )
+* Compute LIWORK workspace needed for CGELSY and CGELSD
+ LIWORK = MAX( LIWORK, N, IWQ )
+* Compute LRWORK workspace needed for CGELSY, CGELSS and CGELSD
+ LRWORK = MAX( LRWORK, LRWORK_CGELSY,
+ $ LRWORK_CGELSS, LRWORK_CGELSD )
+* Compute LWORK workspace needed for all functions
+ LWORK = MAX( LWORK, LWORK_CGELS, LWORK_CGETSLS,
+ $ LWORK_CGELSY, LWORK_CGELSS,
+ $ LWORK_CGELSD )
+ END IF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
*
-* Compute workspace needed for CGELS
- CALL CGELS( 'N', M, N, NRHS, A, LDA, B, LDB,
- $ WORKQUERY, -1, INFO )
- LWORK_CGELS = INT( WORKQUERY )
-* Compute workspace needed for CGETSLS
- CALL CGETSLS( 'N', M, N, NRHS, A, LDA, B, LDB,
- $ WORKQUERY, -1, INFO )
- LWORK_CGETSLS = INT( WORKQUERY )
-* Compute workspace needed for CGELSY
- CALL CGELSY( M, N, NRHS, A, LDA, B, LDB, IWORKQUERY,
- $ RCOND, CRANK, WORKQUERY, -1, RWORK, INFO )
- LWORK_CGELSY = INT( WORKQUERY )
- LRWORK_CGELSY = 2*N
-* Compute workspace needed for CGELSS
- CALL CGELSS( M, N, NRHS, A, LDA, B, LDB, S,
- $ RCOND, CRANK, WORKQUERY, -1, RWORK, INFO )
- LWORK_CGELSS = INT( WORKQUERY )
- LRWORK_CGELSS = 5*MNMIN
-* Compute workspace needed for CGELSD
- CALL CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, CRANK,
- $ WORKQUERY, -1, RWORKQUERY, IWORKQUERY, INFO )
- LWORK_CGELSD = INT( WORKQUERY )
- LRWORK_CGELSD = INT( RWORKQUERY )
-* Compute LIWORK workspace needed for CGELSY and CGELSD
- LIWORK = MAX( 1, N, IWORKQUERY )
-* Compute LRWORK workspace needed for CGELSY, CGELSS and CGELSD
- LRWORK = MAX( 1, LRWORK_CGELSY, LRWORK_CGELSS, LRWORK_CGELSD )
-* Compute LWORK workspace needed for all functions
- LWORK = MAX( 1, LWORK, LWORK_CGELS, LWORK_CGETSLS, LWORK_CGELSY,
- $ LWORK_CGELSS, LWORK_CGELSD )
LWLSY = LWORK
*
ALLOCATE( WORK( LWORK ) )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_lin
*
SUBROUTINE CDRVRF3( NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2,
+ S_WORK_CLANGE, C_WORK_CGEQRF, TAU )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, NN, NOUT
*
IF ( IALPHA.EQ. 1) THEN
ALPHA = ZERO
- ELSE IF ( IALPHA.EQ. 1) THEN
+ ELSE IF ( IALPHA.EQ. 2) THEN
ALPHA = ONE
ELSE
ALPHA = CLARND( 4, ISEED )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_lin
*
SUBROUTINE CDRVRF4( NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A,
+ LDA, S_WORK_CLANGE )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, LDC, NN, NOUT
IF ( IALPHA.EQ. 1) THEN
ALPHA = ZERO
BETA = ZERO
- ELSE IF ( IALPHA.EQ. 1) THEN
+ ELSE IF ( IALPHA.EQ. 2) THEN
ALPHA = ONE
BETA = ZERO
- ELSE IF ( IALPHA.EQ. 1) THEN
+ ELSE IF ( IALPHA.EQ. 3) THEN
ALPHA = ZERO
BETA = ONE
ELSE
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
* @generated from LIN/ddrvsy_aa.f, fortran d -> c, Thu Nov 17 12:14:51 2016
*
$ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
$ RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
EXTERNAL DGET06, CLANSY
* ..
* .. External Subroutines ..
- EXTERNAL ALADHD, ALAERH, ALASVM, DERRVX, CGET04, CLACPY,
- $ CLARHS, CLASET, CLATB4, CLATMS, CSYT02, DSYT05,
+ EXTERNAL ALADHD, ALAERH, ALASVM, CERRVX, CGET04, CLACPY,
+ $ CLARHS, CLASET, CLATB4, CLATMS, CSYT02,
$ CSYSV_AA, CSYT01_AA, CSYTRF_AA, XLAENV
* ..
* .. Scalars in Common ..
DO 10 I = 1, 4
ISEED( I ) = ISEEDY( I )
10 CONTINUE
- LWORK = MAX( 2*NMAX, NMAX*NRHS )
*
* Test the error exits
*
*
DO 180 IN = 1, NN
N = NVAL( IN )
+ LWORK = MAX( 3*N-2, N*(1+NB) )
+ LWORK = MAX( LWORK, 1 )
LDA = MAX( N, 1 )
XTYPE = 'N'
NIMAT = NTYPES
--- /dev/null
+*> \brief \b CDRVSY_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CDRVSY_AA_2STAGE(
+* DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+* NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NOUT, NRHS
+* REAL THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NVAL( * )
+* REAL RWORK( * )
+* COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CDRVSY_AA_2STAGE tests the driver routine CSYSV_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand side vectors to be generated for
+*> each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is REAL
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is COMPLEX array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex_lin
+*
+* =====================================================================
+ SUBROUTINE CDRVSY_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+ $ RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NMAX, NN, NOUT, NRHS
+ REAL THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NVAL( * )
+ REAL RWORK( * )
+ COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX CZERO
+ PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+ INTEGER NTYPES, NTESTS
+ PARAMETER ( NTYPES = 10, NTESTS = 3 )
+ INTEGER NFACT
+ PARAMETER ( NFACT = 2 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
+ CHARACTER*3 MATPATH, PATH
+ INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+ $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+ $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+ REAL ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER FACTS( NFACT ), UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ REAL RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ COMPLEX CLANSY, SGET06
+ EXTERNAL CLANSY, SGET06
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, CERRVX,
+ $ CGET04, CLACPY, CLARHS, CLATB4, CLATMS,
+ $ CSYSV_AA_2STAGE, CSYT01_AA, CSYT02,
+ $ CSYTRF_AA_2STAGE
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CMPLX, MAX, MIN
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Complex precision'
+ PATH( 2: 3 ) = 'S2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Complex precision'
+ MATPATH( 2: 3 ) = 'SY'
+*
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL CERRVX( PATH, NOUT )
+ INFOT = 0
+*
+* Set the block size and minimum block size for testing.
+*
+ NB = 1
+ NBMIN = 2
+ CALL XLAENV( 1, NB )
+ CALL XLAENV( 2, NBMIN )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+* Set up parameters with CLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+ $ MODE, CNDNUM, DIST )
+*
+* Generate a matrix with CLATMS.
+*
+ SRNAMT = 'CLATMS'
+ CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+ $ WORK, INFO )
+*
+* Check error code from CLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N,
+ $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+ GO TO 160
+ END IF
+*
+* For types 3-6, zero one or more rows and columns of
+* the matrix to test that INFO is returned correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IOFF = 0
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+*
+ DO 150 IFACT = 1, NFACT
+*
+* Do first for FACT = 'F', then for other values.
+*
+ FACT = FACTS( IFACT )
+*
+* Form an exact solution and set the right hand side.
+*
+ SRNAMT = 'CLARHS'
+ CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+ $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+ $ INFO )
+ XTYPE = 'C'
+*
+* --- Test CSYSV_AA_2STAGE ---
+*
+ IF( IFACT.EQ.2 ) THEN
+ CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+* Factor the matrix and solve the system using CSYSV_AA.
+*
+ SRNAMT = 'CSYSV_AA_2STAGE '
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL CSYSV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ X, LDA, WORK, LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from CSYSV_AA .
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'CSYSV_AA', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
+ $ IMAT, NFAIL, NERRS, NOUT )
+ GO TO 120
+ ELSE IF( INFO.NE.0 ) THEN
+ GO TO 120
+ END IF
+*
+* Compute residual of the computed solution.
+*
+ CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ CALL CSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 1 ) )
+*
+* Reconstruct matrix from factors and compute
+* residual.
+*
+c CALL CSY01_AA( UPLO, N, A, LDA, AFAC, LDA,
+c $ IWORK, AINV, LDA, RWORK,
+c $ RESULT( 2 ) )
+c NT = 2
+ NT = 1
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALADHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )'CSYSV_AA_2STAGE ',
+ $ UPLO, N, IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+ 120 CONTINUE
+ END IF
+*
+ 150 CONTINUE
+*
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+ $ ', test ', I2, ', ratio =', G12.5 )
+ RETURN
+*
+* End of SDRVSY_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_lin
*
* =====================================================================
SUBROUTINE CERRHE( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
$ CHETRI_3, CHETRI_3X, CHETRI_ROOK, CHETRI2,
$ CHETRI2X, CHETRS, CHETRS_3, CHETRS_ROOK,
$ CHETRS_AA, CHKXER, CHPCON, CHPRFS, CHPTRF,
+ $ CHETRF_AA_2STAGE, CHETRS_AA_2STAGE,
$ CHPTRI, CHPTRS
* ..
* .. Scalars in Common ..
CALL CHECON_3( 'U', 1, A, 1, E, IP, -1.0E0, RCOND, W, INFO)
CALL CHKXER( 'CHECON_3', INFOT, NOUT, LERR, OK )
*
- ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
+ ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
*
* Test error exits of the routines that use factorization
* of a Hermitian indefinite matrix with Aasen's algorithm.
CALL CHETRF_AA( 'U', 2, A, 1, IP, W, 4, INFO )
CALL CHKXER( 'CHETRF_AA', INFOT, NOUT, LERR, OK )
INFOT = 7
- CALL CHETRF_AA( 'U', 0, A, 1, IP, W, 0, INFO )
+ CALL CHETRF_AA( 'U', 2, A, 2, IP, W, 0, INFO )
CALL CHKXER( 'CHETRF_AA', INFOT, NOUT, LERR, OK )
INFOT = 7
- CALL CHETRF_AA( 'U', 0, A, 1, IP, W, -2, INFO )
+ CALL CHETRF_AA( 'U', 2, A, 2, IP, W, -2, INFO )
CALL CHKXER( 'CHETRF_AA', INFOT, NOUT, LERR, OK )
*
* CHETRS_AA
CALL CHETRS_AA( 'U', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
CALL CHKXER( 'CHETRS_AA', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL CHETRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, 0, INFO )
+ CALL CHETRS_AA( 'U', 2, 1, A, 2, IP, B, 2, W, 0, INFO )
CALL CHKXER( 'CHETRS_AA', INFOT, NOUT, LERR, OK )
INFOT = 10
- CALL CHETRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, -2, INFO )
+ CALL CHETRS_AA( 'U', 2, 1, A, 2, IP, B, 2, W, -2, INFO )
CALL CHKXER( 'CHETRS_AA', INFOT, NOUT, LERR, OK )
*
+ ELSE IF( LSAMEN( 2, C2, 'H2' ) ) THEN
+*
+* Test error exits of the routines that use factorization
+* of a symmetric indefinite matrix with Aasen's algorithm.
+*
+* CHETRF_AA_2STAGE
+*
+ SRNAMT = 'CHETRF_AA_2STAGE'
+ INFOT = 1
+ CALL CHETRF_AA_2STAGE( '/', 0, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'CHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CHETRF_AA_2STAGE( 'U', -1, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'CHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL CHETRF_AA_2STAGE( 'U', 2, A, 1, A, 2, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'CHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 6
+ CALL CHETRF_AA_2STAGE( 'U', 2, A, 2, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'CHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 10
+ CALL CHETRF_AA_2STAGE( 'U', 2, A, 2, A, 8, IP, IP, W, 0,
+ $ INFO )
+ CALL CHKXER( 'CHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
+* CHETRS_AA_2STAGE
+*
+ SRNAMT = 'CHETRS_AA_2STAGE'
+ INFOT = 1
+ CALL CHETRS_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CHETRS_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL CHETRS_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL CHETRS_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL CHETRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL CHETRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CHETRS_AA_STAGE', INFOT, NOUT, LERR, OK )
+*
* Test error exits of the routines that use factorization
* of a Hermitian indefinite packed matrix with patrial
* (Bunch-Kaufman) diagonal pivoting method.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_lin
*
* =====================================================================
SUBROUTINE CERRSY( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
CALL CSYTRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, -2, INFO )
CALL CHKXER( 'CSYTRS_AA', INFOT, NOUT, LERR, OK )
*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* Test error exits of the routines that use factorization
+* of a symmetric indefinite matrix with Aasen's algorithm.
+*
+* CSYTRF_AA_2STAGE
+*
+ SRNAMT = 'CSYTRF_AA_2STAGE'
+ INFOT = 1
+ CALL CSYTRF_AA_2STAGE( '/', 0, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'CSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CSYTRF_AA_2STAGE( 'U', -1, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'CSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL CSYTRF_AA_2STAGE( 'U', 2, A, 1, A, 2, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'CSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 6
+ CALL CSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'CSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 10
+ CALL CSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 8, IP, IP, W, 0,
+ $ INFO )
+ CALL CHKXER( 'CSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
+* CHETRS_AA_2STAGE
+*
+ SRNAMT = 'CSYTRS_AA_2STAGE'
+ INFOT = 1
+ CALL CSYTRS_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CSYTRS_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL CSYTRS_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL CSYTRS_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL CSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL CSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'CSYTRS_AA_STAGE', INFOT, NOUT, LERR, OK )
+*
END IF
*
* Print a summary line.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_lin
*
* =====================================================================
SUBROUTINE CERRVX( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
$ CHPSV, CHPSVX, CPBSV, CPBSVX, CPOSV, CPOSVX,
$ CPPSV, CPPSVX, CPTSV, CPTSVX, CSPSV, CSPSVX,
$ CSYSV, CSYSV_AA, CSYSV_RK, CSYSV_ROOK,
- $ CSYSVX
+ $ CSYSVX, CSYSV_AA_2STAGE
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
CALL CHESV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
CALL CHKXER( 'CHESV_AA', INFOT, NOUT, LERR, OK )
*
+ ELSE IF( LSAMEN( 2, C2, 'H2' ) ) THEN
+*
+* CHESV_AASEN_2STAGE
+*
+ SRNAMT = 'CHESV_AA_2STAGE'
+ INFOT = 1
+ CALL CHESV_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CHESV_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL CHESV_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL CHESV_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL CHESV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL CHESV_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP, B, 2,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* CSYSV_AASEN_2STAGE
+*
+ SRNAMT = 'CSYSV_AA_2STAGE'
+ INFOT = 1
+ CALL CSYSV_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL CSYSV_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL CSYSV_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL CSYSV_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL CSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL CSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP, B, 2,
+ $ W, 1, INFO )
+ CALL CHKXER( 'CSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
*
* CHPSV
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_lin
*
SUBROUTINE CHET01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
$ LDC, RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* LOGICAL LERR, OK
* CHARACTER*(*) SRNAMT
* INTEGER INFOT, NOUT
-* ..
-* .. Intrinsic Functions ..
-* INTRINSIC LEN_TRIM
-* ..
-* .. Executable Statements ..
-* IF( .NOT.LERR ) THEN
-* WRITE( NOUT, FMT = 9999 )INFOT,
-* $ SRNAMT( 1:LEN_TRIM( SRNAMT ) )
-* OK = .FALSE.
-* END IF
-* LERR = .FALSE.
-* RETURN
-*
-* 9999 FORMAT( ' *** Illegal value of parameter number ', I2,
-* $ ' not detected by ', A6, ' ***' )
-*
-* End of CHKXER.
-*
-* END
+*
*
*> \par Purpose:
* =============
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_lin
*
* =====================================================================
SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
*
-* -- LAPACK test routine (input) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL LERR, OK
* Definition:
* ===========
*
-* SUBROUTINE CLAHILB(N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
+* SUBROUTINE CLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
* INFO, PATH)
*
* .. Scalar Arguments ..
-* INTEGER T, N, NRHS, LDA, LDX, LDB, INFO
+* INTEGER N, NRHS, LDA, LDX, LDB, INFO
* .. Array Arguments ..
* REAL WORK(N)
* COMPLEX A(LDA,N), X(LDX, NRHS), B(LDB, NRHS)
*>
*> \param[in] NRHS
*> \verbatim
-*> NRHS is NRHS
+*> NRHS is INTEGER
*> The requested number of right-hand sides.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_lin
*
* =====================================================================
- SUBROUTINE CLAHILB(N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
+ SUBROUTINE CLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
$ INFO, PATH)
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
- INTEGER T, N, NRHS, LDA, LDX, LDB, INFO
+ INTEGER N, NRHS, LDA, LDX, LDB, INFO
* .. Array Arguments ..
REAL WORK(N)
COMPLEX A(LDA,N), X(LDX, NRHS), B(LDB, NRHS)
END DO
*
* Generate the scaled Hilbert matrix in A
-* If we are testing SY routines, take D1_i = D2_i, else, D1_i = D2_i*
+* If we are testing SY routines, take
+* D1_i = D2_i, else, D1_i = D2_i*
IF ( LSAMEN( 2, C2, 'SY' ) ) THEN
DO J = 1, N
DO I = 1, N
WORK(J) = ( ( (WORK(J-1)/(J-1)) * (J-1 - N) ) /(J-1) )
$ * (N +J -1)
END DO
-*
-* If we are testing SY routines, take D1_i = D2_i, else, D1_i = D2_i*
+
+* If we are testing SY routines,
+* take D1_i = D2_i, else, D1_i = D2_i*
IF ( LSAMEN( 2, C2, 'SY' ) ) THEN
DO J = 1, NRHS
DO I = 1, N
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
+*> < 0: if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_lin
*
SUBROUTINE CLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
$ A, LDA, X, LDX, B, LDB, ISEED, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS, UPLO, XTYPE
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex_lin
*
SUBROUTINE CSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
$ LDC, RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> DSR 10 List types on next line if 0 < NTYPES < 10
*> DSK 10 List types on next line if 0 < NTYPES < 10
*> DSA 10 List types on next line if 0 < NTYPES < 10
+*> DS2 10 List types on next line if 0 < NTYPES < 10
*> DSP 10 List types on next line if 0 < NTYPES < 10
*> DTR 18 List types on next line if 0 < NTYPES < 18
*> DTP 18 List types on next line if 0 < NTYPES < 18
* =====================================================================
PROGRAM DCHKAA
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
$ RANKVAL( MAXIN ), PIV( NMAX )
DOUBLE PRECISION A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
$ E( NMAX ), RWORK( 5*NMAX+2*MAXRHS ),
- $ S( 2*NMAX ), WORK( NMAX, NMAX+MAXRHS+30 )
+ $ S( 2*NMAX ), WORK( NMAX, 3*NMAX+MAXRHS+30 )
* ..
* .. External Functions ..
LOGICAL LSAME, LSAMEN
END IF
*
*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* SA: symmetric indefinite matrices,
+* with partial (Aasen's) pivoting algorithm
+*
+ NTYPES = 10
+ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+ IF( TSTCHK ) THEN
+ CALL DCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB2, NBVAL2,
+ $ NNS, NSVAL, THRESH, TSTERR, LDA,
+ $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9989 )PATH
+ END IF
+*
+ IF( TSTDRV ) THEN
+ CALL DDRVSY_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9988 )PATH
+ END IF
+*
+*
ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
*
* SP: symmetric indefinite packed matrices,
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_lin
*
$ NBVAL, NOUT )
IMPLICIT NONE
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
DOUBLE PRECISION RESULT( NTESTS )
* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQTP, DLQT04
+ EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQTP, DLQT05
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
* =====================================================================
PROGRAM DCHKRFP
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
STOP
END IF
*
- IF( FATAL ) THEN
- WRITE( NOUT, FMT = 9999 )
- STOP
- END IF
-*
* Calculate and print the machine dependent constants.
*
EPS = DLAMCH( 'Underflow threshold' )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
* @precisions fortran d -> z c
*
$ THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
$ X, XACT, WORK, RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
INTEGER ISEED( 4 ), ISEEDY( 4 )
DOUBLE PRECISION RESULT( NTESTS )
* ..
-* .. External Functions ..
- DOUBLE PRECISION DGET06, DLANSY
- EXTERNAL DGET06, DLANSY
-* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, DERRSY, DGET04, DLACPY,
- $ DLARHS, DLATB4, DLATMS, DPOT02, DPOT03, DPOT05,
- $ DSYCON, DSYRFS, DSYT01_AA, DSYTRF_AA,
- $ DSYTRI2, DSYTRS_AA, XLAENV
+ EXTERNAL ALAERH, ALAHD, ALASUM, DERRSY, DLACPY, DLARHS,
+ $ DLATB4, DLATMS, DPOT02, DSYT01_AA, DSYTRF_AA,
+ $ DSYTRS_AA, XLAENV
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* Adjust the expected value of INFO to account for
* pivoting.
*
- IF( IZERO.GT.0 ) THEN
- J = 1
- K = IZERO
- 100 CONTINUE
- IF( J.EQ.K ) THEN
- K = IWORK( J )
- ELSE IF( IWORK( J ).EQ.K ) THEN
- K = J
- END IF
- IF( J.LT.K ) THEN
- J = J + 1
- GO TO 100
- END IF
- ELSE
+c IF( IZERO.GT.0 ) THEN
+c J = 1
+c K = IZERO
+c 100 CONTINUE
+c IF( J.EQ.K ) THEN
+c K = IWORK( J )
+c ELSE IF( IWORK( J ).EQ.K ) THEN
+c K = J
+c END IF
+c IF( J.LT.K ) THEN
+c J = J + 1
+c GO TO 100
+c END IF
+c ELSE
K = 0
- END IF
+c END IF
*
* Check error code from DSYTRF and handle error.
*
* Check error code from DSYTRS and handle error.
*
IF( INFO.NE.0 ) THEN
- CALL ALAERH( PATH, 'DSYTRS_AA', INFO, 0,
- $ UPLO, N, N, -1, -1, NRHS, IMAT,
- $ NFAIL, NERRS, NOUT )
- END IF
-*
- CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'DSYTRS_AA', INFO, 0,
+ $ UPLO, N, N, -1, -1, NRHS, IMAT,
+ $ NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+ CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
*
-* Compute the residual for the solution
+* Compute the residual for the solution
*
- CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
- $ LDA, RWORK, RESULT( 2 ) )
+ CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
*
*
-* Print information about the tests that did not pass
-* the threshold.
+* Print information about the tests that did not pass
+* the threshold.
*
- DO 120 K = 2, 2
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
- $ IMAT, K, RESULT( K )
- NFAIL = NFAIL + 1
- END IF
- 120 CONTINUE
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
NRUN = NRUN + 1
*
* End do for each value of NRHS in NSVAL.
--- /dev/null
+*> \brief \b DCHKSY_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL,
+* NNS, NSVAL, THRESH, TSTERR, NMAX, A,
+* AFAC, AINV, B, X, XACT, WORK, RWORK,
+* IWORK, NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NNB, NNS, NOUT
+* DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+* DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ RWORK( * ), WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DCHKSY_AA_2STAGE tests DSYTRF_AA_2STAGE, -TRS_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*> NNB is INTEGER
+*> The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*> NBVAL is INTEGER array, dimension (NBVAL)
+*> The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*> NNS is INTEGER
+*> The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*> NSVAL is INTEGER array, dimension (NNS)
+*> The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is DOUBLE PRECISION
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
+*> where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is DOUBLE PRECISION array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+* @precisions fortran d -> z c
+*
+*> \ingroup double_lin
+*
+* =====================================================================
+ SUBROUTINE DCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS,
+ $ NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV,
+ $ B, X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NN, NNB, NNS, NMAX, NOUT
+ DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+ DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ RWORK( * ), WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+ INTEGER NTYPES
+ PARAMETER ( NTYPES = 10 )
+ INTEGER NTESTS
+ PARAMETER ( NTESTS = 9 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, TYPE, UPLO, XTYPE
+ CHARACTER*3 PATH, MATPATH
+ INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+ $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+ $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+ DOUBLE PRECISION ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ DOUBLE PRECISION RESULT( NTESTS )
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALAERH, ALAHD, ALASUM, DERRSY, DLACPY, DLARHS,
+ $ DLATB4, DLATMS, DPOT02, DSYTRF_AA_2STAGE
+ $ DSYTRS_AA_2STAGE, XLAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Double precision'
+ PATH( 2: 3 ) = 'S2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Double precision'
+ MATPATH( 2: 3 ) = 'SY'
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL DERRSY( PATH, NOUT )
+ INFOT = 0
+*
+* Set the minimum block size for which the block routine should
+* be used, which will be later returned by ILAENV
+*
+ CALL XLAENV( 2, 2 )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ IF( N .GT. NMAX ) THEN
+ NFAIL = NFAIL + 1
+ WRITE(NOUT, 9995) 'M ', N, NMAX
+ GO TO 180
+ END IF
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ IZERO = 0
+*
+* Do for each value of matrix type IMAT
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+*
+* Set up parameters with DLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL DLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+ $ ANORM, MODE, CNDNUM, DIST )
+*
+* Generate a matrix with DLATMS.
+*
+ SRNAMT = 'DLATMS'
+ CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from DLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'DLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+* Skip all tests for this generated matrix
+*
+ GO TO 160
+ END IF
+*
+* For matrix types 3-6, zero one or more rows and
+* columns of the matrix to test that INFO is returned
+* correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = ZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = ZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = ZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = ZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+* Do for each value of NB in NBVAL
+*
+ DO 150 INB = 1, NNB
+*
+* Set the optimal blocksize, which will be later
+* returned by ILAENV.
+*
+ NB = NBVAL( INB )
+ CALL XLAENV( 1, NB )
+*
+* Copy the test matrix A into matrix AFAC which
+* will be factorized in place. This is needed to
+* preserve the test matrix A for subsequent tests.
+*
+ CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+* Compute the L*D*L**T or U*D*U**T factorization of the
+* matrix. IWORK stores details of the interchanges and
+* the block structure of D. AINV is a work array for
+* block factorization, LWORK is the length of AINV.
+*
+ SRNAMT = 'DSYTRF_AA_2STAGE'
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL DSYTRF_AA_2STAGE( UPLO, N, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ WORK, LWORK,
+ $ INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from DSYTRF and handle error.
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'DSYTRF_AA_2STAGE', INFO, K,
+ $ UPLO, N, N, -1, -1, NB, IMAT, NFAIL,
+ $ NERRS, NOUT )
+ END IF
+*
+*+ TEST 1
+* Reconstruct matrix from factors and compute residual.
+*
+c CALL DSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+c $ AINV, LDA, RWORK, RESULT( 1 ) )
+c NT = 1
+ NT = 0
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+ $ RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+*
+* Skip solver test if INFO is not 0.
+*
+ IF( INFO.NE.0 ) THEN
+ GO TO 140
+ END IF
+*
+* Do for each value of NRHS in NSVAL.
+*
+ DO 130 IRHS = 1, NNS
+ NRHS = NSVAL( IRHS )
+*
+*+ TEST 2 (Using TRS)
+* Solve and compute residual for A * X = B.
+*
+* Choose a set of NRHS random solution vectors
+* stored in XACT and set up the right hand side B
+*
+ SRNAMT = 'DLARHS'
+ CALL DLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+ $ KL, KU, NRHS, A, LDA, XACT, LDA,
+ $ B, LDA, ISEED, INFO )
+ CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+ SRNAMT = 'DSYTRS_AA_2STAGE'
+ LWORK = MAX( 1, 3*N-2 )
+ CALL DSYTRS_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N, IWORK, IWORK( 1+N ),
+ $ X, LDA, INFO )
+*
+* Check error code from DSYTRS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'DSYTRS_AA_2STAGE',
+ $ INFO, 0, UPLO, N, N, -1, -1,
+ $ NRHS, IMAT, NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+ CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
+*
+* Compute the residual for the solution
+*
+ CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
+ NRUN = NRUN + 1
+*
+* End do for each value of NRHS in NSVAL.
+*
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+ $ I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+ $ I6 )
+ RETURN
+*
+* End of DCHKSY_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_lin
*
$ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B,
$ COPYB, C, S, COPYS, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
DOUBLE PRECISION EPS, NORMA, NORMB, RCOND
* ..
* .. Local Arrays ..
- INTEGER ISEED( 4 ), ISEEDY( 4 ), IWORKQUERY
- DOUBLE PRECISION RESULT( NTESTS ), WORKQUERY
+ INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ
+ DOUBLE PRECISION RESULT( NTESTS ), WQ
* ..
* .. Allocatable Arrays ..
DOUBLE PRECISION, ALLOCATABLE :: WORK (:)
M = MMAX
N = NMAX
NRHS = NSMAX
- LDA = MAX( 1, M )
- LDB = MAX( 1, M, N )
MNMIN = MAX( MIN( M, N ), 1 )
*
* Compute workspace needed for routines
* DQRT14, DQRT17 (two side cases), DQRT15 and DQRT12
*
- LWORK = MAX( ( M+N )*NRHS,
+ LWORK = MAX( 1, ( M+N )*NRHS,
$ ( N+NRHS )*( M+2 ), ( M+NRHS )*( N+2 ),
$ MAX( M+MNMIN, NRHS*MNMIN,2*N+M ),
$ MAX( M*N+4*MNMIN+MAX(M,N), M*N+2*MNMIN+4*N ) )
+ LIWORK = 1
+*
+* Iterate through all test cases and compute necessary workspace
+* sizes for ?GELS, ?GETSLS, ?GELSY, ?GELSS and ?GELSD routines.
+*
+ DO IM = 1, NM
+ M = MVAL( IM )
+ LDA = MAX( 1, M )
+ DO IN = 1, NN
+ N = NVAL( IN )
+ MNMIN = MAX(MIN( M, N ),1)
+ LDB = MAX( 1, M, N )
+ DO INS = 1, NNS
+ NRHS = NSVAL( INS )
+ DO IRANK = 1, 2
+ DO ISCALE = 1, 3
+ ITYPE = ( IRANK-1 )*3 + ISCALE
+ IF( DOTYPE( ITYPE ) ) THEN
+ IF( IRANK.EQ.1 ) THEN
+ DO ITRAN = 1, 2
+ IF( ITRAN.EQ.1 ) THEN
+ TRANS = 'N'
+ ELSE
+ TRANS = 'T'
+ END IF
+*
+* Compute workspace needed for DGELS
+ CALL DGELS( TRANS, M, N, NRHS, A, LDA,
+ $ B, LDB, WQ, -1, INFO )
+ LWORK_DGELS = INT ( WQ )
+* Compute workspace needed for DGETSLS
+ CALL DGETSLS( TRANS, M, N, NRHS, A, LDA,
+ $ B, LDB, WQ, -1, INFO )
+ LWORK_DGETSLS = INT( WQ )
+ ENDDO
+ END IF
+* Compute workspace needed for DGELSY
+ CALL DGELSY( M, N, NRHS, A, LDA, B, LDB, IWQ,
+ $ RCOND, CRANK, WQ, -1, INFO )
+ LWORK_DGELSY = INT( WQ )
+* Compute workspace needed for DGELSS
+ CALL DGELSS( M, N, NRHS, A, LDA, B, LDB, S,
+ $ RCOND, CRANK, WQ, -1 , INFO )
+ LWORK_DGELSS = INT( WQ )
+* Compute workspace needed for DGELSD
+ CALL DGELSD( M, N, NRHS, A, LDA, B, LDB, S,
+ $ RCOND, CRANK, WQ, -1, IWQ, INFO )
+ LWORK_DGELSD = INT( WQ )
+* Compute LIWORK workspace needed for DGELSY and DGELSD
+ LIWORK = MAX( LIWORK, N, IWQ )
+* Compute LWORK workspace needed for all functions
+ LWORK = MAX( LWORK, LWORK_DGELS, LWORK_DGETSLS,
+ $ LWORK_DGELSY, LWORK_DGELSS,
+ $ LWORK_DGELSD )
+ END IF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
*
-* Compute workspace needed for DGELS
- CALL DGELS( 'N', M, N, NRHS, A, LDA, B, LDB,
- $ WORKQUERY, -1, INFO )
- LWORK_DGELS = INT ( WORKQUERY )
-* Compute workspace needed for DGETSLS
- CALL DGETSLS( 'N', M, N, NRHS, A, LDA, B, LDB,
- $ WORKQUERY, -1, INFO )
- LWORK_DGETSLS = INT( WORKQUERY )
-* Compute workspace needed for DGELSY
- CALL DGELSY( M, N, NRHS, A, LDA, B, LDB, IWORKQUERY,
- $ RCOND, CRANK, WORKQUERY, -1, INFO )
- LWORK_DGELSY = INT( WORKQUERY )
-* Compute workspace needed for DGELSS
- CALL DGELSS( M, N, NRHS, A, LDA, B, LDB, S,
- $ RCOND, CRANK, WORKQUERY, -1 , INFO )
- LWORK_DGELSS = INT( WORKQUERY )
-* Compute workspace needed for DGELSD
- CALL DGELSD( M, N, NRHS, A, LDA, B, LDB, S,
- $ RCOND, CRANK, WORKQUERY, -1, IWORKQUERY, INFO )
- LWORK_DGELSD = INT( WORKQUERY )
-* Compute LIWORK workspace needed for DGELSY and DGELSD
- LIWORK = MAX( 1, N, IWORKQUERY )
-* Compute LWORK workspace needed for all functions
- LWORK = MAX( 1, LWORK, LWORK_DGELS, LWORK_DGETSLS, LWORK_DGELSY,
- $ LWORK_DGELSS, LWORK_DGELSD )
LWLSY = LWORK
*
ALLOCATE( WORK( LWORK ) )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_lin
*
SUBROUTINE DDRVRF3( NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2,
+ D_WORK_DLANGE, D_WORK_DGEQRF, TAU )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, NN, NOUT
*
IF ( IALPHA.EQ. 1) THEN
ALPHA = ZERO
- ELSE IF ( IALPHA.EQ. 1) THEN
+ ELSE IF ( IALPHA.EQ. 2) THEN
ALPHA = ONE
ELSE
ALPHA = DLARND( 2, ISEED )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
* @precisions fortran d -> z c
*
$ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
$ RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
* ..
* .. External Subroutines ..
EXTERNAL ALADHD, ALAERH, ALASVM, DERRVX, DGET04, DLACPY,
- $ DLARHS, DLASET, DLATB4, DLATMS, DPOT02, DPOT05,
+ $ DLARHS, DLASET, DLATB4, DLATMS, DPOT02,
$ DSYSV_AA, DSYT01_AA, DSYTRF_AA, XLAENV
* ..
* .. Scalars in Common ..
DO 10 I = 1, 4
ISEED( I ) = ISEEDY( I )
10 CONTINUE
- LWORK = MAX( 2*NMAX, NMAX*NRHS )
*
* Test the error exits
*
*
DO 180 IN = 1, NN
N = NVAL( IN )
+ LWORK = MAX( 3*N-2, N*(1+NB) )
+ LWORK = MAX( LWORK, 1 )
LDA = MAX( N, 1 )
XTYPE = 'N'
NIMAT = NTYPES
--- /dev/null
+*> \brief \b DDRVSY_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DDRVSY_AA_2STAGE(
+* DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+* NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NOUT, NRHS
+* DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NVAL( * )
+* DOUBLE PRECISION RWORK( * )
+* DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DDRVSY_AA_2STAGE tests the driver routine DSYSV_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand side vectors to be generated for
+*> each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is DOUBLE PRECISION
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup double_lin
+*
+* =====================================================================
+ SUBROUTINE DDRVSY_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+ $ RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NMAX, NN, NOUT, NRHS
+ DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NVAL( * )
+ DOUBLE PRECISION RWORK( * )
+ DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+ INTEGER NTYPES, NTESTS
+ PARAMETER ( NTYPES = 10, NTESTS = 3 )
+ INTEGER NFACT
+ PARAMETER ( NFACT = 2 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
+ CHARACTER*3 MATPATH, PATH
+ INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+ $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+ $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+ DOUBLE PRECISION ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER FACTS( NFACT ), UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ DOUBLE PRECISION RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLANSY, SGET06
+ EXTERNAL DLANSY, SGET06
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, DERRVX,
+ $ DGET04, DLACPY, DLARHS, DLATB4, DLATMS,
+ $ DSYSV_AA_2STAGE, CHET01_AA, DPOT02,
+ $ DSYTRF_AA_2STAGE
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CMPLX, MAX, MIN
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Double precision'
+ PATH( 2: 3 ) = 'S2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Double precision'
+ MATPATH( 2: 3 ) = 'SY'
+*
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL DERRVX( PATH, NOUT )
+ INFOT = 0
+*
+* Set the block size and minimum block size for testing.
+*
+ NB = 1
+ NBMIN = 2
+ CALL XLAENV( 1, NB )
+ CALL XLAENV( 2, NBMIN )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+* Set up parameters with DLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL DLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+ $ MODE, CNDNUM, DIST )
+*
+* Generate a matrix with DLATMS.
+*
+ SRNAMT = 'DLATMS'
+ CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+ $ WORK, INFO )
+*
+* Check error code from DLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'DLATMS', INFO, 0, UPLO, N, N,
+ $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+ GO TO 160
+ END IF
+*
+* For types 3-6, zero one or more rows and columns of
+* the matrix to test that INFO is returned correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = ZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = ZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IOFF = 0
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = ZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = ZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+*
+ DO 150 IFACT = 1, NFACT
+*
+* Do first for FACT = 'F', then for other values.
+*
+ FACT = FACTS( IFACT )
+*
+* Form an exact solution and set the right hand side.
+*
+ SRNAMT = 'DLARHS'
+ CALL DLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+ $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+ $ INFO )
+ XTYPE = 'C'
+*
+* --- Test DSYSV_AA_2STAGE ---
+*
+ IF( IFACT.EQ.2 ) THEN
+ CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+ CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+* Factor the matrix and solve the system using DSYSV_AA.
+*
+ SRNAMT = 'DSYSV_AA_2STAGE '
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL DSYSV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ X, LDA, WORK, LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from DSYSV_AA .
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'DSYSV_AA', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
+ $ IMAT, NFAIL, NERRS, NOUT )
+ GO TO 120
+ ELSE IF( INFO.NE.0 ) THEN
+ GO TO 120
+ END IF
+*
+* Compute residual of the computed solution.
+*
+ CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 1 ) )
+*
+* Reconstruct matrix from factors and compute
+* residual.
+*
+c CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA,
+c $ IWORK, AINV, LDA, RWORK,
+c $ RESULT( 2 ) )
+c NT = 2
+ NT = 1
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALADHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )'DSYSV_AA ',
+ $ UPLO, N, IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+ 120 CONTINUE
+ END IF
+*
+ 150 CONTINUE
+*
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+ $ ', test ', I2, ', ratio =', G12.5 )
+ RETURN
+*
+* End of DDRVSY_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_lin
*
* =====================================================================
SUBROUTINE DERRSY( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
$ DSYTRF_RK, DSYTRF_ROOK, DSYTRF_AA, DSYTRI,
$ DSYTRI_3, DSYTRI_3X, DSYTRI_ROOK, DSYTRI2,
$ DSYTRI2X, DSYTRS, DSYTRS_3, DSYTRS_ROOK,
- $ DSYTRS_AA
+ $ DSYTRS_AA, DSYTRF_AA_2STAGE, DSYTRS_AA_2STAGE
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
CALL DSYTRS_AA( 'U', 0, 1, A, 2, IP, B, 1, W, -2, INFO )
CALL CHKXER( 'DSYTRS_AA', INFOT, NOUT, LERR, OK )
*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* Test error exits of the routines that use factorization
+* of a symmetric indefinite matrix with Aasen's algorithm.
+*
+* DSYTRF_AA_2STAGE
+*
+ SRNAMT = 'DSYTRF_AA_2STAGE'
+ INFOT = 1
+ CALL DSYTRF_AA_2STAGE( '/', 0, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'DSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL DSYTRF_AA_2STAGE( 'U', -1, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'DSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL DSYTRF_AA_2STAGE( 'U', 2, A, 1, A, 2, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'DSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 6
+ CALL DSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'DSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 10
+ CALL DSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 8, IP, IP, W, 0,
+ $ INFO )
+ CALL CHKXER( 'DSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
+* DSYTRS_AA_2STAGE
+*
+ SRNAMT = 'DSYTRS_AA_2STAGE'
+ INFOT = 1
+ CALL DSYTRS_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'DSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL DSYTRS_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'DSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL DSYTRS_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'DSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL DSYTRS_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'DSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL DSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'DSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL DSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'DSYTRS_AA_STAGE', INFOT, NOUT, LERR, OK )
ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
*
* Test error exits of the routines that use factorization
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_lin
*
* =====================================================================
SUBROUTINE DERRVX( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
EXTERNAL CHKXER, DGBSV, DGBSVX, DGESV, DGESVX, DGTSV,
$ DGTSVX, DPBSV, DPBSVX, DPOSV, DPOSVX, DPPSV,
$ DPPSVX, DPTSV, DPTSVX, DSPSV, DSPSVX, DSYSV,
- $ DSYSV_AA, DSYSV_RK, DSYSV_ROOK, DSYSVX
+ $ DSYSV_AA, DSYSV_RK, DSYSV_ROOK, DSYSVX,
+ $ DSYSV_AA_2STAGE
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
CALL DSYSV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
CALL CHKXER( 'DSYSV_AA', INFOT, NOUT, LERR, OK )
*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* DSYSV_AASEN_2STAGE
+*
+ SRNAMT = 'DSYSV_AA_2STAGE'
+ INFOT = 1
+ CALL DSYSV_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'DSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL DSYSV_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'DSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL DSYSV_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'DSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL DSYSV_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'DSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL DSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'DSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL DSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP, B, 2,
+ $ W, 1, INFO )
+ CALL CHKXER( 'DSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
*
* DSPSV
* Definition:
* ===========
*
-* SUBROUTINE DLAHILB(N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
+* SUBROUTINE DLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
*
* .. Scalar Arguments ..
* INTEGER N, NRHS, LDA, LDX, LDB, INFO
*>
*> \param[in] NRHS
*> \verbatim
-*> NRHS is NRHS
+*> NRHS is INTEGER
*> The requested number of right-hand sides.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_lin
*
* =====================================================================
- SUBROUTINE DLAHILB(N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
+ SUBROUTINE DLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER N, NRHS, LDA, LDX, LDB, INFO
INTEGER TM, TI, R
INTEGER M
INTEGER I, J
- COMPLEX*16 TMP
* ..
* .. Parameters ..
* NMAX_EXACT the largest dimension where the generated data is
*
* Generate matrix B as simply the first NRHS columns of M * the
* identity.
- TMP = DBLE(M)
- CALL DLASET('Full', N, NRHS, 0.0D+0, TMP, B, LDB)
-*
+ CALL DLASET('Full', N, NRHS, 0.0D+0, DBLE(M), B, LDB)
+
* Generate the true solutions in X. Because B = the first NRHS
* columns of M*I, the true solutions are just the first NRHS columns
* of the inverse Hilbert matrix.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_lin
*
SUBROUTINE DSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
$ LDC, RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup aux_lin
*
INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
$ N4 )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*( * ) NAME, OPTS
* End of ILAENV
*
END
+ INTEGER FUNCTION ILAENV2STAGE( ISPEC, NAME, OPTS, N1, N2,
+ $ N3, N4 )
+* .. Scalar Arguments ..
+ CHARACTER*( * ) NAME, OPTS
+ INTEGER ISPEC, N1, N2, N3, N4
+* ..
+*
+* =====================================================================
+*
+* .. Local variables ..
+ INTEGER IISPEC
+* .. External Functions ..
+ INTEGER IPARAM2STAGE
+ EXTERNAL IPARAM2STAGE
+* ..
+* .. Arrays in Common ..
+ INTEGER IPARMS( 100 )
+* ..
+* .. Common blocks ..
+ COMMON / CLAENV / IPARMS
+* ..
+* .. Save statement ..
+ SAVE / CLAENV /
+* ..
+* .. Executable Statements ..
+*
+ IF(( ISPEC.GE.1 ) .AND. (ISPEC.LE.5)) THEN
+*
+* 1 <= ISPEC <= 5: 2stage eigenvalues SVD routines.
+*
+ IF( ISPEC.EQ.1 ) THEN
+ ILAENV2STAGE = IPARMS( 1 )
+ ELSE
+ IISPEC = 16 + ISPEC
+ ILAENV2STAGE = IPARAM2STAGE( IISPEC, NAME, OPTS,
+ $ N1, N2, N3, N4 )
+ ENDIF
+*
+ ELSE
+*
+* Invalid value for ISPEC
+*
+ ILAENV2STAGE = -1
+ END IF
+*
+ RETURN
+ END
*> SSR 10 List types on next line if 0 < NTYPES < 10
*> SSK 10 List types on next line if 0 < NTYPES < 10
*> SSA 10 List types on next line if 0 < NTYPES < 10
+*> SS2 10 List types on next line if 0 < NTYPES < 10
*> SSP 10 List types on next line if 0 < NTYPES < 10
*> STR 18 List types on next line if 0 < NTYPES < 18
*> STP 18 List types on next line if 0 < NTYPES < 18
* =====================================================================
PROGRAM SCHKAA
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
$ SCHKTP, SCHKTR, SCHKTZ, SDRVGB, SDRVGE, SDRVGT,
$ SDRVLS, SDRVPB, SDRVPO, SDRVPP, SDRVPT, SDRVSP,
$ SDRVSY, SDRVSY_ROOK, SDRVSY_RK, SDRVSY_AA,
- $ ILAVER, SCHKLQTP, SCHKQRT, SCHKQRTP
+ $ ILAVER, SCHKLQTP, SCHKQRT, SCHKQRTP,
+ $ SCHKLQT, SCHKTSQR
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
WRITE( NOUT, FMT = 9988 )PATH
END IF
*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* SA: symmetric indefinite matrices,
+* with partial (Aasen's) pivoting algorithm
+*
+ NTYPES = 10
+ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+ IF( TSTCHK ) THEN
+ CALL SCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB2, NBVAL2,
+ $ NNS, NSVAL, THRESH, TSTERR, LDA,
+ $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9989 )PATH
+ END IF
+*
+ IF( TSTDRV ) THEN
+ CALL SDRVSY_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9988 )PATH
+ END IF
+*
ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
*
* SP: symmetric indefinite packed matrices,
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_lin
*
$ NBVAL, NOUT )
IMPLICIT NONE
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
REAL RESULT( NTESTS )
* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQTP, DLQT04
+ EXTERNAL ALAERH, ALAHD, ALASUM, SERRLQTP, SLQT05
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_lin
*
$ NBVAL, NOUT )
IMPLICIT NONE
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
REAL RESULT( NTESTS )
* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, SERRQRTP
+ EXTERNAL ALAERH, ALAHD, ALASUM, SERRQRTP, SQRT05
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
* =====================================================================
PROGRAM SCHKRFP
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
STOP
END IF
*
- IF( FATAL ) THEN
- WRITE( NOUT, FMT = 9999 )
- STOP
- END IF
-*
* Calculate and print the machine dependent constants.
*
EPS = SLAMCH( 'Underflow threshold' )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
-*
-* @precisions fortran d -> z c
+*> \date November 2017
*
*> \ingroup real_lin
*
$ THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
$ X, XACT, WORK, RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
INTEGER ISEED( 4 ), ISEEDY( 4 )
REAL RESULT( NTESTS )
* ..
-* .. External Functions ..
- REAL DGET06, SLANSY
- EXTERNAL DGET06, SLANSY
-* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, SERRSY, SGET04, SLACPY,
- $ SLARHS, SLATB4, SLATMS, SPOT02, DPOT03, DPOT05,
- $ DSYCON, SSYRFS, SSYT01_AA, SSYTRF_AA,
- $ DSYTRI2, SSYTRS_AA, XLAENV
+ EXTERNAL ALAERH, ALAHD, ALASUM, SERRSY, SLACPY, SLARHS,
+ $ SLATB4, SLATMS, SPOT02, SSYT01_AA, SSYTRF_AA,
+ $ SSYTRS_AA, XLAENV
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* Adjust the expected value of INFO to account for
* pivoting.
*
- IF( IZERO.GT.0 ) THEN
- J = 1
- K = IZERO
- 100 CONTINUE
- IF( J.EQ.K ) THEN
- K = IWORK( J )
- ELSE IF( IWORK( J ).EQ.K ) THEN
- K = J
- END IF
- IF( J.LT.K ) THEN
- J = J + 1
- GO TO 100
- END IF
- ELSE
+c IF( IZERO.GT.0 ) THEN
+c J = 1
+c K = IZERO
+c 100 CONTINUE
+c IF( J.EQ.K ) THEN
+c K = IWORK( J )
+c ELSE IF( IWORK( J ).EQ.K ) THEN
+c K = J
+c END IF
+c IF( J.LT.K ) THEN
+c J = J + 1
+c GO TO 100
+c END IF
+c ELSE
K = 0
- END IF
+c END IF
*
* Check error code from SSYTRF and handle error.
*
* Check error code from SSYTRS and handle error.
*
IF( INFO.NE.0 ) THEN
- CALL ALAERH( PATH, 'SSYTRS_AA', INFO, 0,
- $ UPLO, N, N, -1, -1, NRHS, IMAT,
- $ NFAIL, NERRS, NOUT )
- END IF
-*
- CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'SSYTRS_AA', INFO, 0,
+ $ UPLO, N, N, -1, -1, NRHS, IMAT,
+ $ NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+ CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
*
-* Compute the residual for the solution
+* Compute the residual for the solution
*
- CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
- $ LDA, RWORK, RESULT( 2 ) )
+ CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
*
*
* Print information about the tests that did not pass
* the threshold.
*
- DO 120 K = 2, 2
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
- $ IMAT, K, RESULT( K )
- NFAIL = NFAIL + 1
- END IF
- 120 CONTINUE
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
NRUN = NRUN + 1
*
* End do for each value of NRHS in NSVAL.
--- /dev/null
+*> \brief \b SCHKSY_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL,
+* NNS, NSVAL, THRESH, TSTERR, NMAX, A,
+* AFAC, AINV, B, X, XACT, WORK, RWORK,
+* IWORK, NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NNB, NNS, NOUT
+* REAL THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+* REAL A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ RWORK( * ), WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SCHKSY_AA_2STAGE tests SSYTRF_AA_2STAGE, -TRS_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*> NNB is INTEGER
+*> The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*> NBVAL is INTEGER array, dimension (NBVAL)
+*> The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*> NNS is INTEGER
+*> The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*> NSVAL is INTEGER array, dimension (NNS)
+*> The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is REAL
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is REAL array, dimension (NMAX*NSMAX)
+*> where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is REAL array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is REAL array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is REAL array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup real_lin
+*
+* =====================================================================
+ SUBROUTINE SCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS,
+ $ NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV,
+ $ B, X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NN, NNB, NNS, NMAX, NOUT
+ REAL THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+ REAL A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ RWORK( * ), WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E+0 )
+ INTEGER NTYPES
+ PARAMETER ( NTYPES = 10 )
+ INTEGER NTESTS
+ PARAMETER ( NTESTS = 9 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, TYPE, UPLO, XTYPE
+ CHARACTER*3 PATH, MATPATH
+ INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+ $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+ $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+ REAL ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ REAL RESULT( NTESTS )
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALAERH, ALAHD, ALASUM, SERRSY, SLACPY, SLARHS,
+ $ SLATB4, SLATMS, SPOT02, SSYT01_AA,
+ $ SSYTRF_AA_2STAGE, SSYTRS_AA_2STAGE,
+ $ XLAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Single precision'
+ PATH( 2: 3 ) = 'S2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Single precision'
+ MATPATH( 2: 3 ) = 'SY'
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL SERRSY( PATH, NOUT )
+ INFOT = 0
+*
+* Set the minimum block size for which the block routine should
+* be used, which will be later returned by ILAENV
+*
+ CALL XLAENV( 2, 2 )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ IF( N .GT. NMAX ) THEN
+ NFAIL = NFAIL + 1
+ WRITE(NOUT, 9995) 'M ', N, NMAX
+ GO TO 180
+ END IF
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ IZERO = 0
+*
+* Do for each value of matrix type IMAT
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+*
+* Set up parameters with SLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL SLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+ $ ANORM, MODE, CNDNUM, DIST )
+*
+* Generate a matrix with SLATMS.
+*
+ SRNAMT = 'SLATMS'
+ CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from SLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+* Skip all tests for this generated matrix
+*
+ GO TO 160
+ END IF
+*
+* For matrix types 3-6, zero one or more rows and
+* columns of the matrix to test that INFO is returned
+* correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = ZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = ZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = ZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = ZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+* Do for each value of NB in NBVAL
+*
+ DO 150 INB = 1, NNB
+*
+* Set the optimal blocksize, which will be later
+* returned by ILAENV.
+*
+ NB = NBVAL( INB )
+ CALL XLAENV( 1, NB )
+*
+* Copy the test matrix A into matrix AFAC which
+* will be factorized in place. This is needed to
+* preserve the test matrix A for subsequent tests.
+*
+ CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+* Compute the L*D*L**T or U*D*U**T factorization of the
+* matrix. IWORK stores details of the interchanges and
+* the block structure of D. AINV is a work array for
+* block factorization, LWORK is the length of AINV.
+*
+ SRNAMT = 'SSYTRF_AA_2STAGE'
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL SSYTRF_AA_2STAGE( UPLO, N, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ WORK, LWORK,
+ $ INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from SSYTRF and handle error.
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'SSYTRF_AA_2STAGE', INFO, K,
+ $ UPLO, N, N, -1, -1, NB, IMAT, NFAIL,
+ $ NERRS, NOUT )
+ END IF
+*
+*+ TEST 1
+* Reconstruct matrix from factors and compute residual.
+*
+* CALL SSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+* $ AINV, LDA, RWORK, RESULT( 1 ) )
+* NT = 1
+ NT = 0
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+ $ RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+*
+* Skip solver test if INFO is not 0.
+*
+ IF( INFO.NE.0 ) THEN
+ GO TO 140
+ END IF
+*
+* Do for each value of NRHS in NSVAL.
+*
+ DO 130 IRHS = 1, NNS
+ NRHS = NSVAL( IRHS )
+*
+*+ TEST 2 (Using TRS)
+* Solve and compute residual for A * X = B.
+*
+* Choose a set of NRHS random solution vectors
+* stored in XACT and set up the right hand side B
+*
+ SRNAMT = 'SLARHS'
+ CALL SLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+ $ KL, KU, NRHS, A, LDA, XACT, LDA,
+ $ B, LDA, ISEED, INFO )
+ CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+ SRNAMT = 'SSYTRS_AA_2STAGE'
+ LWORK = MAX( 1, 3*N-2 )
+ CALL SSYTRS_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N, IWORK, IWORK( 1+N ),
+ $ X, LDA, INFO )
+*
+* Check error code from SSYTRS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'SSYTRS_AA_2STAGE',
+ $ INFO, 0, UPLO, N, N, -1, -1,
+ $ NRHS, IMAT, NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+ CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
+*
+* Compute the residual for the solution
+*
+ CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
+ NRUN = NRUN + 1
+*
+* End do for each value of NRHS in NSVAL.
+*
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+ $ I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+ $ I6 )
+ RETURN
+*
+* End of DCHKSY_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_lin
*
$ THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B,
$ X, XACT, WORK, RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
CHARACTER DIST, TYPE, UPLO, XTYPE
CHARACTER*3 PATH, MATPATH
INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
- $ ITEMP, IUPLO, IZERO, J, K, KL, KU, LDA, LWORK,
+ $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK,
$ MODE, N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN,
$ NT
REAL ALPHA, ANORM, CNDNUM, CONST, STEMP, SING_MAX,
* ..
* .. Local Arrays ..
CHARACTER UPLOS( 2 )
- INTEGER IDUMMY( 1 ), ISEED( 4 ), ISEEDY( 4 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
REAL BLOCK( 2, 2 ), SDUMMY( 1 ), RESULT( NTESTS )
* ..
* .. External Functions ..
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_lin
*
$ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B,
$ COPYB, C, S, COPYS, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
REAL EPS, NORMA, NORMB, RCOND
* ..
* .. Local Arrays ..
- INTEGER ISEED( 4 ), ISEEDY( 4 ), IWORKQUERY
- REAL RESULT( NTESTS ), WORKQUERY
+ INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ
+ REAL RESULT( NTESTS ), WQ
* ..
* .. Allocatable Arrays ..
REAL, ALLOCATABLE :: WORK (:)
EXTERNAL ALAERH, ALAHD, ALASVM, SAXPY, SERRLS, SGELS,
$ SGELSD, SGELSS, SGELSY, SGEMM, SLACPY,
$ SLARNV, SQRT13, SQRT15, SQRT16, SSCAL,
- $ XLAENV
+ $ XLAENV, SGETSLS
* ..
* .. Intrinsic Functions ..
INTRINSIC INT, LOG, MAX, MIN, REAL, SQRT
M = MMAX
N = NMAX
NRHS = NSMAX
- LDA = MAX( 1, M )
- LDB = MAX( 1, M, N )
MNMIN = MAX( MIN( M, N ), 1 )
*
* Compute workspace needed for routines
* SQRT14, SQRT17 (two side cases), SQRT15 and SQRT12
*
- LWORK = MAX( ( M+N )*NRHS,
+ LWORK = MAX( 1, ( M+N )*NRHS,
$ ( N+NRHS )*( M+2 ), ( M+NRHS )*( N+2 ),
$ MAX( M+MNMIN, NRHS*MNMIN,2*N+M ),
$ MAX( M*N+4*MNMIN+MAX(M,N), M*N+2*MNMIN+4*N ) )
+ LIWORK = 1
+*
+* Iterate through all test cases and compute necessary workspace
+* sizes for ?GELS, ?GETSLS, ?GELSY, ?GELSS and ?GELSD routines.
+*
+ DO IM = 1, NM
+ M = MVAL( IM )
+ LDA = MAX( 1, M )
+ DO IN = 1, NN
+ N = NVAL( IN )
+ MNMIN = MAX(MIN( M, N ),1)
+ LDB = MAX( 1, M, N )
+ DO INS = 1, NNS
+ NRHS = NSVAL( INS )
+ DO IRANK = 1, 2
+ DO ISCALE = 1, 3
+ ITYPE = ( IRANK-1 )*3 + ISCALE
+ IF( DOTYPE( ITYPE ) ) THEN
+ IF( IRANK.EQ.1 ) THEN
+ DO ITRAN = 1, 2
+ IF( ITRAN.EQ.1 ) THEN
+ TRANS = 'N'
+ ELSE
+ TRANS = 'T'
+ END IF
+*
+* Compute workspace needed for SGELS
+ CALL SGELS( TRANS, M, N, NRHS, A, LDA,
+ $ B, LDB, WQ, -1, INFO )
+ LWORK_SGELS = INT ( WQ )
+* Compute workspace needed for SGETSLS
+ CALL SGETSLS( TRANS, M, N, NRHS, A, LDA,
+ $ B, LDB, WQ, -1, INFO )
+ LWORK_SGETSLS = INT( WQ )
+ ENDDO
+ END IF
+* Compute workspace needed for SGELSY
+ CALL SGELSY( M, N, NRHS, A, LDA, B, LDB, IWQ,
+ $ RCOND, CRANK, WQ, -1, INFO )
+ LWORK_SGELSY = INT( WQ )
+* Compute workspace needed for SGELSS
+ CALL SGELSS( M, N, NRHS, A, LDA, B, LDB, S,
+ $ RCOND, CRANK, WQ, -1 , INFO )
+ LWORK_SGELSS = INT( WQ )
+* Compute workspace needed for SGELSD
+ CALL SGELSD( M, N, NRHS, A, LDA, B, LDB, S,
+ $ RCOND, CRANK, WQ, -1, IWQ, INFO )
+ LWORK_SGELSD = INT( WQ )
+* Compute LIWORK workspace needed for SGELSY and SGELSD
+ LIWORK = MAX( LIWORK, N, IWQ )
+* Compute LWORK workspace needed for all functions
+ LWORK = MAX( LWORK, LWORK_SGELS, LWORK_SGETSLS,
+ $ LWORK_SGELSY, LWORK_SGELSS,
+ $ LWORK_SGELSD )
+ END IF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
*
-* Compute workspace needed for SGELS
- CALL SGELS( 'N', M, N, NRHS, A, LDA, B, LDB,
- $ WORKQUERY, -1, INFO )
- LWORK_SGELS = INT ( WORKQUERY )
-* Compute workspace needed for SGETSLS
- CALL SGETSLS( 'N', M, N, NRHS, A, LDA, B, LDB,
- $ WORKQUERY, -1, INFO )
- LWORK_SGETSLS = INT( WORKQUERY )
-* Compute workspace needed for SGELSY
- CALL SGELSY( M, N, NRHS, A, LDA, B, LDB, IWORKQUERY,
- $ RCOND, CRANK, WORKQUERY, -1, INFO )
- LWORK_SGELSY = INT( WORKQUERY )
-* Compute workspace needed for SGELSS
- CALL SGELSS( M, N, NRHS, A, LDA, B, LDB, S,
- $ RCOND, CRANK, WORKQUERY, -1 , INFO )
- LWORK_SGELSS = INT( WORKQUERY )
-* Compute workspace needed for SGELSD
- CALL SGELSD( M, N, NRHS, A, LDA, B, LDB, S,
- $ RCOND, CRANK, WORKQUERY, -1, IWORKQUERY, INFO )
- LWORK_SGELSD = INT( WORKQUERY )
-* Compute LIWORK workspace needed for SGELSY and SGELSD
- LIWORK = MAX( 1, N, IWORKQUERY )
-* Compute LWORK workspace needed for all functions
- LWORK = MAX( 1, LWORK, LWORK_SGELS, LWORK_SGETSLS, LWORK_SGELSY,
- $ LWORK_SGELSS, LWORK_SGELSD )
LWLSY = LWORK
*
ALLOCATE( WORK( LWORK ) )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup single_lin
*
SUBROUTINE SDRVRF3( NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2,
+ S_WORK_SLANGE, S_WORK_SGEQRF, TAU )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, NN, NOUT
*
IF ( IALPHA.EQ. 1) THEN
ALPHA = ZERO
- ELSE IF ( IALPHA.EQ. 1) THEN
+ ELSE IF ( IALPHA.EQ. 2) THEN
ALPHA = ONE
ELSE
ALPHA = SLARND( 2, ISEED )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup real_lin
*
$ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
$ RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
* ..
* .. External Subroutines ..
EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGET04, SLACPY,
- $ SLARHS, SLASET, SLATB4, SLATMS, SPOT02, DPOT05,
+ $ SLARHS, SLASET, SLATB4, SLATMS, SPOT02,
$ SSYSV_AA, SSYT01_AA, SSYTRF_AA, XLAENV
* ..
* .. Scalars in Common ..
DO 10 I = 1, 4
ISEED( I ) = ISEEDY( I )
10 CONTINUE
- LWORK = MAX( 2*NMAX, NMAX*NRHS )
*
* Test the error exits
*
*
DO 180 IN = 1, NN
N = NVAL( IN )
+ LWORK = MAX( 3*N-2, N*(1+NB) )
+ LWORK = MAX( LWORK, 1 )
LDA = MAX( N, 1 )
XTYPE = 'N'
NIMAT = NTYPES
--- /dev/null
+*> \brief \b SDRVSY_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SDRVSY_AA_2STAGE(
+* DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+* NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NOUT, NRHS
+* REAL THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NVAL( * )
+* REAL RWORK( * )
+* REAL A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SDRVSY_AA_2STAGE tests the driver routine SSYSV_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand side vectors to be generated for
+*> each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is REAL
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is REAL array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is REAL array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is REAL array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup real_lin
+*
+* =====================================================================
+ SUBROUTINE SDRVSY_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+ $ RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NMAX, NN, NOUT, NRHS
+ REAL THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NVAL( * )
+ REAL RWORK( * )
+ REAL A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+ INTEGER NTYPES, NTESTS
+ PARAMETER ( NTYPES = 10, NTESTS = 3 )
+ INTEGER NFACT
+ PARAMETER ( NFACT = 2 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
+ CHARACTER*3 MATPATH, PATH
+ INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+ $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+ $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+ REAL ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER FACTS( NFACT ), UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ REAL RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ REAL SLANSY, SGET06
+ EXTERNAL SLANSY, SGET06
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, SERRVX,
+ $ CGET04, SLACPY, SLARHS, SLATB4, SLATMS,
+ $ SSYSV_AA_2STAGE, SSYT01_AA, SPOT02,
+ $ SSYTRF_AA_2STAGE
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CMPLX, MAX, MIN
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Single precision'
+ PATH( 2: 3 ) = 'S2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Single precision'
+ MATPATH( 2: 3 ) = 'SY'
+*
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL SERRVX( PATH, NOUT )
+ INFOT = 0
+*
+* Set the block size and minimum block size for testing.
+*
+ NB = 1
+ NBMIN = 2
+ CALL XLAENV( 1, NB )
+ CALL XLAENV( 2, NBMIN )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+* Set up parameters with SLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL SLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+ $ MODE, CNDNUM, DIST )
+*
+* Generate a matrix with SLATMS.
+*
+ SRNAMT = 'SLATMS'
+ CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+ $ WORK, INFO )
+*
+* Check error code from SLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N,
+ $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+ GO TO 160
+ END IF
+*
+* For types 3-6, zero one or more rows and columns of
+* the matrix to test that INFO is returned correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = ZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = ZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IOFF = 0
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = ZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = ZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+*
+ DO 150 IFACT = 1, NFACT
+*
+* Do first for FACT = 'F', then for other values.
+*
+ FACT = FACTS( IFACT )
+*
+* Form an exact solution and set the right hand side.
+*
+ SRNAMT = 'SLARHS'
+ CALL SLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+ $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+ $ INFO )
+ XTYPE = 'C'
+*
+* --- Test SSYSV_AA_2STAGE ---
+*
+ IF( IFACT.EQ.2 ) THEN
+ CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+ CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+* Factor the matrix and solve the system using SSYSV_AA.
+*
+ SRNAMT = 'SSYSV_AA_2STAGE '
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL SSYSV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ X, LDA, WORK, LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from SSYSV_AA .
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'SSYSV_AA', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
+ $ IMAT, NFAIL, NERRS, NOUT )
+ GO TO 120
+ ELSE IF( INFO.NE.0 ) THEN
+ GO TO 120
+ END IF
+*
+* Compute residual of the computed solution.
+*
+ CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 1 ) )
+*
+* Reconstruct matrix from factors and compute
+* residual.
+*
+c CALL SSY01_AA( UPLO, N, A, LDA, AFAC, LDA,
+c $ IWORK, AINV, LDA, RWORK,
+c $ RESULT( 2 ) )
+c NT = 2
+ NT = 1
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALADHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )'SSYSV_AA ',
+ $ UPLO, N, IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+ 120 CONTINUE
+ END IF
+*
+ 150 CONTINUE
+*
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+ $ ', test ', I2, ', ratio =', G12.5 )
+ RETURN
+*
+* End of SDRVSY_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_lin
*
* =====================================================================
SUBROUTINE SERRSY( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
$ SSYTF2_RK, SSYTF2_ROOK, SSYTRF, SSYTRF_RK,
$ SSYTRF_ROOK, SSYTRI, SSYTF2, SSYTRI_3,
$ SSYTRI_3X, SSYTRI_ROOK, SSYTRF_AA, SSYTRI2,
- $ SYTRI2X, SSYTRS, SSYTRS_3, SSYTRS_ROOK,
- $ SSYTRS_AA
+ $ SSYTRI2X, SSYTRS, SSYTRS_3, SSYTRS_ROOK,
+ $ SSYTRS_AA, SSYTRF_AA_2STAGE, SSYTRS_AA_2STAGE
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
INFOT = 10
CALL SSYTRS_AA( 'U', 0, 1, A, 2, IP, B, 1, W, -2, INFO )
CALL CHKXER( 'SSYTRS_AA', INFOT, NOUT, LERR, OK )
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* Test error exits of the routines that use factorization
+* of a symmetric indefinite matrix with Aasen's algorithm.
+*
+* SSYTRF_AA_2STAGE
+*
+ SRNAMT = 'SSYTRF_AA_2STAGE'
+ INFOT = 1
+ CALL SSYTRF_AA_2STAGE( '/', 0, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL SSYTRF_AA_2STAGE( 'U', -1, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL SSYTRF_AA_2STAGE( 'U', 2, A, 1, A, 2, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 6
+ CALL SSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 10
+ CALL SSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 8, IP, IP, W, 0,
+ $ INFO )
+ CALL CHKXER( 'SSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
+* SSYTRS_AA_2STAGE
+*
+ SRNAMT = 'SSYTRS_AA_2STAGE'
+ INFOT = 1
+ CALL SSYTRS_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL SSYTRS_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL SSYTRS_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL SSYTRS_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL SSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'SSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL SSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'SSYTRS_AA_STAGE', INFOT, NOUT, LERR, OK )
*
ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup single_lin
*
* =====================================================================
SUBROUTINE SERRVX( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
EXTERNAL CHKXER, SGBSV, SGBSVX, SGESV, SGESVX, SGTSV,
$ SGTSVX, SPBSV, SPBSVX, SPOSV, SPOSVX, SPPSV,
$ SPPSVX, SPTSV, SPTSVX, SSPSV, SSPSVX, SSYSV,
- $ SSYSV_AA, SSYSV_RK, SSYSV_ROOK, SSYSVX
+ $ SSYSV_AA, SSYSV_RK, SSYSV_ROOK, SSYSVX,
+ $ SSYSV_AA_2STAGE
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
CALL SSYSV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
CALL CHKXER( 'SSYSV_AA', INFOT, NOUT, LERR, OK )
*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* DSYSV_AASEN_2STAGE
+*
+ SRNAMT = 'SSYSV_AA_2STAGE'
+ INFOT = 1
+ CALL SSYSV_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'SSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL SSYSV_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'SSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL SSYSV_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'SSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL SSYSV_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'SSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL SSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'SSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL SSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP, B, 2,
+ $ W, 1, INFO )
+ CALL CHKXER( 'SSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
*
* SSPSV
* Definition:
* ===========
*
-* SUBROUTINE SLAHILB(N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
+* SUBROUTINE SLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
*
* .. Scalar Arguments ..
* INTEGER N, NRHS, LDA, LDX, LDB, INFO
*>
*> \param[in] NRHS
*> \verbatim
-*> NRHS is NRHS
+*> NRHS is INTEGER
*> The requested number of right-hand sides.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup single_lin
*
* =====================================================================
- SUBROUTINE SLAHILB(N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
+ SUBROUTINE SLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER N, NRHS, LDA, LDX, LDB, INFO
SUBROUTINE SQRT04(M,N,NB,RESULT)
IMPLICIT NONE
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* .. Local Arrays ..
INTEGER ISEED( 4 )
* ..
+* .. External Subroutine ..
+ EXTERNAL SGEMM, SLACPY, SLARNV, SGEMQRT, SLASET, SGEQRT, SSYRK
+* ..
* .. External Functions ..
REAL SLAMCH
REAL SLANGE, SLANSY
SUBROUTINE SQRT05(M,N,L,NB,RESULT)
IMPLICIT NONE
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* .. Local Arrays ..
INTEGER ISEED( 4 )
* ..
+* .. External Subroutine ..
+ EXTERNAL SGEMM, SLARNV, STPMQRT, STPQRT, SGEMQRT, SSYRK, SLACPY,
+ $ SLASET
+* ..
* .. External Functions ..
REAL SLAMCH
REAL SLANGE, SLANSY
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup single_lin
*
SUBROUTINE SSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
$ LDC, RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*
*> \ingroup real_lin
SUBROUTINE SSYT01_AA( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
$ LDC, RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
EXTERNAL LSAME, SLAMCH, SLANSY
* ..
* .. External Subroutines ..
- EXTERNAL SLASET, SLAVSY
+ EXTERNAL SLASET, SLAVSY, SSWAP, STRMM, SLACPY
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE
*> ZHR 10 List types on next line if 0 < NTYPES < 10
*> ZHK 10 List types on next line if 0 < NTYPES < 10
*> ZHA 10 List types on next line if 0 < NTYPES < 10
+*> ZH2 10 List types on next line if 0 < NTYPES < 10
+*> ZSA 11 List types on next line if 0 < NTYPES < 10
+*> ZS2 11 List types on next line if 0 < NTYPES < 10
*> ZHP 10 List types on next line if 0 < NTYPES < 10
*> ZSY 11 List types on next line if 0 < NTYPES < 11
*> ZSR 11 List types on next line if 0 < NTYPES < 11
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_lin
*
* =====================================================================
PROGRAM ZCHKAA
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* =====================================================================
*
$ ZCHKSY_ROOK, ZCHKSY_RK, ZCHKSY_AA, ZCHKTB,
$ ZCHKTP, ZCHKTR, ZCHKTZ, ZDRVGB, ZDRVGE, ZDRVGT,
$ ZDRVHE, ZDRVHE_ROOK, ZDRVHE_RK, ZDRVHE_AA,
- $ ZDRVHP, ZDRVLS, ZDRVPB, ZDRVPO, ZDRVPP, ZDRVPT,
- $ ZDRVSP, ZDRVSY, ZDRVSY_ROOK, ZDRVSY_RK,
- $ ZDRVSY_AA, ILAVER, ZCHKQRT, ZCHKQRTP, ZCHKLQT,
- $ ZCHKLQTP, ZCHKTSQR
+ $ ZDRVHE_AA_2STAGE, ZDRVHP, ZDRVLS, ZDRVPB,
+ $ ZDRVPO, ZDRVPP, ZDRVPT, ZDRVSP, ZDRVSY,
+ $ ZDRVSY_ROOK, ZDRVSY_RK, ZDRVSY_AA,
+ $ ZDRVSY_AA_2STAGE, ILAVER, ZCHKQRT, ZCHKQRTP,
+ $ ZCHKLQT, ZCHKLQTP, ZCHKTSQR
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
*
ELSE IF( LSAMEN( 2, C2, 'HA' ) ) THEN
*
-* HA: Hermitian indefinite matrices,
-* with partial (Aasen's) pivoting algorithm
+* HA: Hermitian matrices,
+* Aasen Algorithm
*
NTYPES = 10
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
WRITE( NOUT, FMT = 9988 )PATH
END IF
*
+ ELSE IF( LSAMEN( 2, C2, 'H2' ) ) THEN
+*
+* H2: Hermitian matrices,
+* with partial (Aasen's) pivoting algorithm
+*
+ NTYPES = 10
+ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+ IF( TSTCHK ) THEN
+ CALL ZCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB2, NBVAL2,
+ $ NNS, NSVAL, THRESH, TSTERR, LDA,
+ $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9989 )PATH
+ END IF
+*
+ IF( TSTDRV ) THEN
+ CALL ZDRVHE_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9988 )PATH
+ END IF
+*
+*
ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
*
* HP: Hermitian indefinite packed matrices
*
ELSE IF( LSAMEN( 2, C2, 'SA' ) ) THEN
*
-* SK: symmetric indefinite matrices,
-* with bounded Bunch-Kaufman (rook) pivoting algorithm,
-* differnet matrix storage format than SR path version.
+* SA: symmetric indefinite matrices with Aasen's algorithm,
*
NTYPES = 11
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
WRITE( NOUT, FMT = 9988 )PATH
END IF
*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* S2: symmetric indefinite matrices with Aasen's algorithm
+* 2 stage
+*
+ NTYPES = 11
+ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
+*
+ IF( TSTCHK ) THEN
+ CALL ZCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS,
+ $ NSVAL, THRESH, TSTERR, LDA,
+ $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
+ $ WORK, RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9989 )PATH
+ END IF
+*
+ IF( TSTDRV ) THEN
+ CALL ZDRVSY_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
+ $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK,
+ $ RWORK, IWORK, NOUT )
+ ELSE
+ WRITE( NOUT, FMT = 9988 )PATH
+ END IF
+*
ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
*
* SP: symmetric indefinite packed matrices,
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*
*> \ingroup complex16_lin
$ THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
$ X, XACT, WORK, RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
INTEGER ISEED( 4 ), ISEEDY( 4 )
DOUBLE PRECISION RESULT( NTESTS )
* ..
-* .. External Functions ..
- DOUBLE PRECISION DGET06, ZLANHE
- EXTERNAL DGET06, ZLANHE
-* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRHE, ZGET04,
- $ ZHECON, ZHERFS, ZHET01_AA, ZHETRF_AA, ZHETRI2,
- $ ZHETRS_AA, ZLACPY, ZLAIPD, ZLARHS, ZLATB4,
- $ ZLATMS, ZPOT02, ZPOT03, ZPOT05
+ EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRHE,
+ $ ZHET01_AA, ZHETRF_AA, ZHETRS_AA, ZLACPY,
+ $ ZLAIPD, ZLARHS, ZLATB4, ZLATMS, ZPOT02
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* Adjust the expected value of INFO to account for
* pivoting.
*
- IF( IZERO.GT.0 ) THEN
- J = 1
- K = IZERO
- 100 CONTINUE
- IF( J.EQ.K ) THEN
- K = IWORK( J )
- ELSE IF( IWORK( J ).EQ.K ) THEN
- K = J
- END IF
- IF( J.LT.K ) THEN
- J = J + 1
- GO TO 100
- END IF
- ELSE
+c IF( IZERO.GT.0 ) THEN
+c J = 1
+c K = IZERO
+c 100 CONTINUE
+c IF( J.EQ.K ) THEN
+c K = IWORK( J )
+c ELSE IF( IWORK( J ).EQ.K ) THEN
+c K = J
+c END IF
+c IF( J.LT.K ) THEN
+c J = J + 1
+c GO TO 100
+c END IF
+c ELSE
K = 0
- END IF
+c END IF
*
* Check error code from ZHETRF and handle error.
*
* Check error code from ZHETRS and handle error.
*
IF( INFO.NE.0 ) THEN
- CALL ALAERH( PATH, 'ZHETRS', INFO, 0, UPLO, N,
- $ N, -1, -1, NRHS, IMAT, NFAIL,
- $ NERRS, NOUT )
- END IF
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'ZHETRS_AA', INFO, 0,
+ $ UPLO, N, N, -1, -1, NRHS, IMAT,
+ $ NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
*
- CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
*
-* Compute the residual for the solution
+* Compute the residual for the solution
*
- CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
- $ LDA, RWORK, RESULT( 2 ) )
+ CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
*
-* Print information about the tests that did not pass
-* the threshold.
+* Print information about the tests that did not pass
+* the threshold.
*
- DO 120 K = 2, 2
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
- $ IMAT, K, RESULT( K )
- NFAIL = NFAIL + 1
- END IF
- 120 CONTINUE
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
NRUN = NRUN + 1
*
* End do for each value of NRHS in NSVAL.
--- /dev/null
+*> \brief \b ZCHKHE_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL,
+* NNS, NSVAL, THRESH, TSTERR, NMAX, A,
+* AFAC, AINV, B, X, XACT, WORK, RWORK,
+* IWORK, NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NNB, NNS, NOUT
+* DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+* DOUBLE PRECISION RWORK( * )
+* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZCHKSY_AA_2STAGE tests ZHETRF_AA_2STAGE, -TRS_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*> NNB is INTEGER
+*> The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*> NBVAL is INTEGER array, dimension (NBVAL)
+*> The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*> NNS is INTEGER
+*> The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*> NSVAL is INTEGER array, dimension (NNS)
+*> The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is DOUBLE PRECISION
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is DOUBLE PRECISION array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16_lin
+*
+* =====================================================================
+ SUBROUTINE ZCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS,
+ $ NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV,
+ $ B, X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NN, NNB, NNS, NMAX, NOUT
+ DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+ COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ RWORK( * ), WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+ COMPLEX*16 CZERO
+ PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+ INTEGER NTYPES
+ PARAMETER ( NTYPES = 10 )
+ INTEGER NTESTS
+ PARAMETER ( NTESTS = 9 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, TYPE, UPLO, XTYPE
+ CHARACTER*3 PATH, MATPATH
+ INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+ $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+ $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+ DOUBLE PRECISION ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ DOUBLE PRECISION RESULT( NTESTS )
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALAERH, ALAHD, ALASUM, ZERRHE, ZLACPY,
+ $ ZLARHS, ZLATB4, ZLATMS, ZPOT02,
+ $ ZHETRF_AA_2STAGE, ZHETRS_AA_2STAGE,
+ $ XLAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Zomplex precision'
+ PATH( 2: 3 ) = 'H2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Zomplex precision'
+ MATPATH( 2: 3 ) = 'HE'
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL ZERRHE( PATH, NOUT )
+ INFOT = 0
+*
+* Set the minimum block size for which the block routine should
+* be used, which will be later returned by ILAENV
+*
+ CALL XLAENV( 2, 2 )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ IF( N .GT. NMAX ) THEN
+ NFAIL = NFAIL + 1
+ WRITE(NOUT, 9995) 'M ', N, NMAX
+ GO TO 180
+ END IF
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ IZERO = 0
+*
+* Do for each value of matrix type IMAT
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+*
+* Set up parameters with ZLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+ $ ANORM, MODE, CNDNUM, DIST )
+*
+* Generate a matrix with ZLATMS.
+*
+ SRNAMT = 'ZLATMS'
+ CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from ZLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+* Skip all tests for this generated matrix
+*
+ GO TO 160
+ END IF
+*
+* For matrix types 3-6, zero one or more rows and
+* columns of the matrix to test that INFO is returned
+* correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate test matrix A.
+*
+*
+* Set the imaginary part of the diagonals.
+*
+ CALL ZLAIPD( N, A, LDA+1, 0 )
+*
+* Do for each value of NB in NBVAL
+*
+ DO 150 INB = 1, NNB
+*
+* Set the optimal blocksize, which will be later
+* returned by ILAENV.
+*
+ NB = NBVAL( INB )
+ CALL XLAENV( 1, NB )
+*
+* Copy the test matrix A into matrix AFAC which
+* will be factorized in place. This is needed to
+* preserve the test matrix A for subsequent tests.
+*
+ CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+* Compute the L*D*L**T or U*D*U**T factorization of the
+* matrix. IWORK stores details of the interchanges and
+* the block structure of D. AINV is a work array for
+* block factorization, LWORK is the length of AINV.
+*
+ SRNAMT = 'ZHETRF_AA_2STAGE'
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL ZHETRF_AA_2STAGE( UPLO, N, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ WORK, LWORK,
+ $ INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from CHETRF and handle error.
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'ZHETRF_AA_2STAGE', INFO, K,
+ $ UPLO, N, N, -1, -1, NB, IMAT, NFAIL,
+ $ NERRS, NOUT )
+ END IF
+*
+*+ TEST 1
+* Reconstruct matrix from factors and compute residual.
+*
+* NEED TO CREATE ZHET01_AA_2STAGE
+* CALL ZHET01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+* $ AINV, LDA, RWORK, RESULT( 1 ) )
+* NT = 1
+ NT = 0
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+ $ RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+*
+* Skip solver test if INFO is not 0.
+*
+ IF( INFO.NE.0 ) THEN
+ GO TO 140
+ END IF
+*
+* Do for each value of NRHS in NSVAL.
+*
+ DO 130 IRHS = 1, NNS
+ NRHS = NSVAL( IRHS )
+*
+*+ TEST 2 (Using TRS)
+* Solve and compute residual for A * X = B.
+*
+* Choose a set of NRHS random solution vectors
+* stored in XACT and set up the right hand side B
+*
+ SRNAMT = 'ZLARHS'
+ CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+ $ KL, KU, NRHS, A, LDA, XACT, LDA,
+ $ B, LDA, ISEED, INFO )
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+ SRNAMT = 'ZHETRS_AA_2STAGE'
+ LWORK = MAX( 1, 3*N-2 )
+ CALL ZHETRS_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N, IWORK, IWORK( 1+N ),
+ $ X, LDA, INFO )
+*
+* Check error code from ZHETRS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'ZHETRS_AA_2STAGE',
+ $ INFO, 0, UPLO, N, N, -1, -1,
+ $ NRHS, IMAT, NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+*
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
+*
+* Compute the residual for the solution
+*
+ CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
+ NRUN = NRUN + 1
+*
+* End do for each value of NRHS in NSVAL.
+*
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+ $ I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+ $ I6 )
+ RETURN
+*
+* End of ZCHKSY_AA_2STAGE
+*
+ END
* =====================================================================
PROGRAM ZCHKRFP
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
STOP
END IF
*
- IF( FATAL ) THEN
- WRITE( NOUT, FMT = 9999 )
- STOP
- END IF
-*
* Calculate and print the machine dependent constants.
*
EPS = DLAMCH( 'Underflow threshold' )
* .. Scalar Arguments ..
* LOGICAL TSTERR
* INTEGER NMAX, NN, NNB, NNS, NOUT
-* COMPLEX*16 THRESH
+* DOUBLE PRECISION THRESH
* ..
* .. Array Arguments ..
* LOGICAL DOTYPE( * )
* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+* DOUBLE PRECISION RWORK( * )
* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
-* $ RWORK( * ), WORK( * ), X( * ), XACT( * )
+* $ WORK( * ), X( * ), XACT( * )
* ..
*
*
*>
*> \param[in] THRESH
*> \verbatim
-*> THRESH is COMPLEX*16
+*> THRESH is DOUBLE PRECISION
*> The threshold value for the test ratios. A result is
*> included in the output file if RESULT >= THRESH. To have
*> every test ratio printed, use THRESH = 0.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
-*
-* @generated from LIN/dchksy_aa.f, fortran d -> z, Wed Nov 16 21:34:18 2016
+*> \date November 2017
*
*> \ingroup complex16_lin
*
$ THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
$ X, XACT, WORK, RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
IMPLICIT NONE
*
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D+0 )
COMPLEX*16 CZERO
- PARAMETER ( CZERO = 0.0E+0 )
+ PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
INTEGER NTYPES
PARAMETER ( NTYPES = 10 )
INTEGER NTESTS
INTEGER ISEED( 4 ), ISEEDY( 4 )
DOUBLE PRECISION RESULT( NTESTS )
* ..
-* .. External Functions ..
- DOUBLE PRECISION DGET06, ZLANSY
- EXTERNAL DGET06, ZLANSY
-* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, ZERRSY, ZGET04, ZLACPY,
- $ ZLARHS, ZLATB4, ZLATMS, ZSYT02, DSYT03, DSYT05,
- $ DSYCON, ZSYRFS, ZSYT01_AA, ZSYTRF_AA,
- $ DSYTRI2, ZSYTRS_AA, XLAENV
+ EXTERNAL ALAERH, ALAHD, ALASUM, ZERRSY, ZLACPY, ZLARHS,
+ $ ZLATB4, ZLATMS, ZSYT02, ZSYT01_AA, ZSYTRF_AA,
+ $ ZSYTRS_AA, XLAENV
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* Adjust the expected value of INFO to account for
* pivoting.
*
- IF( IZERO.GT.0 ) THEN
- J = 1
- K = IZERO
- 100 CONTINUE
- IF( J.EQ.K ) THEN
- K = IWORK( J )
- ELSE IF( IWORK( J ).EQ.K ) THEN
- K = J
- END IF
- IF( J.LT.K ) THEN
- J = J + 1
- GO TO 100
- END IF
- ELSE
+c IF( IZERO.GT.0 ) THEN
+c J = 1
+c K = IZERO
+c 100 CONTINUE
+c IF( J.EQ.K ) THEN
+c K = IWORK( J )
+c ELSE IF( IWORK( J ).EQ.K ) THEN
+c K = J
+c END IF
+c IF( J.LT.K ) THEN
+c J = J + 1
+c GO TO 100
+c END IF
+c ELSE
K = 0
- END IF
+c END IF
*
* Check error code from ZSYTRF and handle error.
*
* Check error code from ZSYTRS and handle error.
*
IF( INFO.NE.0 ) THEN
- CALL ALAERH( PATH, 'ZSYTRS_AA', INFO, 0,
- $ UPLO, N, N, -1, -1, NRHS, IMAT,
- $ NFAIL, NERRS, NOUT )
- END IF
-*
- CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'ZSYTRS_AA', INFO, 0,
+ $ UPLO, N, N, -1, -1, NRHS, IMAT,
+ $ NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
*
-* Compute the residual for the solution
+* Compute the residual for the solution
*
- CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
- $ LDA, RWORK, RESULT( 2 ) )
+ CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
*
*
-* Print information about the tests that did not pass
-* the threshold.
+* Print information about the tests that did not pass
+* the threshold.
*
- DO 120 K = 2, 2
- IF( RESULT( K ).GE.THRESH ) THEN
- IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
- $ CALL ALAHD( NOUT, PATH )
- WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
- $ IMAT, K, RESULT( K )
- NFAIL = NFAIL + 1
- END IF
- 120 CONTINUE
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
NRUN = NRUN + 1
*
* End do for each value of NRHS in NSVAL.
--- /dev/null
+*> \brief \b ZCHKSY_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL,
+* NNS, NSVAL, THRESH, TSTERR, NMAX, A,
+* AFAC, AINV, B, X, XACT, WORK, RWORK,
+* IWORK, NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NNB, NNS, NOUT
+* DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+* DOUBLE PRECISION RWORK( * )
+* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZCHKSY_AA_2STAGE tests ZSYTRF_AA_2STAGE, -TRS_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NNB
+*> \verbatim
+*> NNB is INTEGER
+*> The number of values of NB contained in the vector NBVAL.
+*> \endverbatim
+*>
+*> \param[in] NBVAL
+*> \verbatim
+*> NBVAL is INTEGER array, dimension (NBVAL)
+*> The values of the blocksize NB.
+*> \endverbatim
+*>
+*> \param[in] NNS
+*> \verbatim
+*> NNS is INTEGER
+*> The number of values of NRHS contained in the vector NSVAL.
+*> \endverbatim
+*>
+*> \param[in] NSVAL
+*> \verbatim
+*> NSVAL is INTEGER array, dimension (NNS)
+*> The values of the number of right hand sides NRHS.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is DOUBLE PRECISION
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> where NSMAX is the largest entry in NSVAL.
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is COMPLEX*16 array, dimension (max(NMAX,2*NSMAX))
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (2*NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16_lin
+*
+* =====================================================================
+ SUBROUTINE ZCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS,
+ $ NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV,
+ $ B, X, XACT, WORK, RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+ IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NN, NNB, NNS, NMAX, NOUT
+ DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
+ DOUBLE PRECISION RWORK( * )
+ COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 CZERO
+ PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+ INTEGER NTYPES
+ PARAMETER ( NTYPES = 10 )
+ INTEGER NTESTS
+ PARAMETER ( NTESTS = 9 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, TYPE, UPLO, XTYPE
+ CHARACTER*3 PATH, MATPATH
+ INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
+ $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
+ $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
+ DOUBLE PRECISION ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ DOUBLE PRECISION RESULT( NTESTS )
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALAERH, ALAHD, ALASUM, CERRSY, ZLACPY, ZLARHS,
+ $ CLATB4, ZLATMS, ZSYT02, ZSYT01,
+ $ ZSYTRF_AA_2STAGE, ZSYTRS_AA_2STAGE,
+ $ XLAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Zomplex precision'
+ PATH( 2: 3 ) = 'S2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Zomplex precision'
+ MATPATH( 2: 3 ) = 'SY'
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL ZERRSY( PATH, NOUT )
+ INFOT = 0
+*
+* Set the minimum block size for which the block routine should
+* be used, which will be later returned by ILAENV
+*
+ CALL XLAENV( 2, 2 )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ IF( N .GT. NMAX ) THEN
+ NFAIL = NFAIL + 1
+ WRITE(NOUT, 9995) 'M ', N, NMAX
+ GO TO 180
+ END IF
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ IZERO = 0
+*
+* Do for each value of matrix type IMAT
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+*
+* Set up parameters with ZLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU,
+ $ ANORM, MODE, CNDNUM, DIST )
+*
+* Generate a matrix with ZLATMS.
+*
+ SRNAMT = 'ZLATMS'
+ CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
+ $ INFO )
+*
+* Check error code from ZLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
+ $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
+*
+* Skip all tests for this generated matrix
+*
+ GO TO 160
+ END IF
+*
+* For matrix types 3-6, zero one or more rows and
+* columns of the matrix to test that INFO is returned
+* correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the last IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+* Do for each value of NB in NBVAL
+*
+ DO 150 INB = 1, NNB
+*
+* Set the optimal blocksize, which will be later
+* returned by ILAENV.
+*
+ NB = NBVAL( INB )
+ CALL XLAENV( 1, NB )
+*
+* Copy the test matrix A into matrix AFAC which
+* will be factorized in place. This is needed to
+* preserve the test matrix A for subsequent tests.
+*
+ CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+*
+* Compute the L*D*L**T or U*D*U**T factorization of the
+* matrix. IWORK stores details of the interchanges and
+* the block structure of D. AINV is a work array for
+* block factorization, LWORK is the length of AINV.
+*
+ SRNAMT = 'ZSYTRF_AA_2STAGE'
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL ZSYTRF_AA_2STAGE( UPLO, N, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ WORK, LWORK,
+ $ INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from ZSYTRF and handle error.
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'ZSYTRF_AA_2STAGE', INFO, K,
+ $ UPLO, N, N, -1, -1, NB, IMAT, NFAIL,
+ $ NERRS, NOUT )
+ END IF
+*
+*+ TEST 1
+* Reconstruct matrix from factors and compute residual.
+*
+c CALL ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
+c $ AINV, LDA, RWORK, RESULT( 1 ) )
+c NT = 1
+ NT = 0
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
+ $ RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+*
+* Skip solver test if INFO is not 0.
+*
+ IF( INFO.NE.0 ) THEN
+ GO TO 140
+ END IF
+*
+* Do for each value of NRHS in NSVAL.
+*
+ DO 130 IRHS = 1, NNS
+ NRHS = NSVAL( IRHS )
+*
+*+ TEST 2 (Using TRS)
+* Solve and compute residual for A * X = B.
+*
+* Choose a set of NRHS random solution vectors
+* stored in XACT and set up the right hand side B
+*
+ SRNAMT = 'ZLARHS'
+ CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N,
+ $ KL, KU, NRHS, A, LDA, XACT, LDA,
+ $ B, LDA, ISEED, INFO )
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+ SRNAMT = 'ZSYTRS_AA_2STAGE'
+ LWORK = MAX( 1, 3*N-2 )
+ CALL ZSYTRS_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N, IWORK, IWORK( 1+N ),
+ $ X, LDA, INFO )
+*
+* Check error code from ZSYTRS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ IF( IZERO.EQ.0 ) THEN
+ CALL ALAERH( PATH, 'ZSYTRS_AA_2STAGE',
+ $ INFO, 0, UPLO, N, N, -1, -1,
+ $ NRHS, IMAT, NFAIL, NERRS, NOUT )
+ END IF
+ ELSE
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA
+ $ )
+*
+* Compute the residual for the solution
+*
+ CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA,
+ $ WORK, LDA, RWORK, RESULT( 2 ) )
+*
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 120 K = 2, 2
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALAHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
+ $ IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 120 CONTINUE
+ END IF
+ NRUN = NRUN + 1
+*
+* End do for each value of NRHS in NSVAL.
+*
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
+ $ I2, ', test ', I2, ', ratio =', G12.5 )
+ 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
+ $ I2, ', test(', I2, ') =', G12.5 )
+ 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
+ $ I6 )
+ RETURN
+*
+* End of ZCHKSY_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup double_lin
*
$ NBVAL, NOUT )
IMPLICIT NONE
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
DOUBLE PRECISION RESULT( NTESTS )
* ..
* .. External Subroutines ..
- EXTERNAL ALAERH, ALAHD, ALASUM, DERRTSQR,
- $ DTSQR01, XLAENV
+ EXTERNAL ALAERH, ALAHD, ALASUM, ZERRTSQR,
+ $ ZTSQR01, XLAENV
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_lin
*
$ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
$ RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
DO 10 I = 1, 4
ISEED( I ) = ISEEDY( I )
10 CONTINUE
- LWORK = MAX( 2*NMAX, NMAX*NRHS )
*
* Test the error exits
*
*
DO 180 IN = 1, NN
N = NVAL( IN )
+ LWORK = MAX( 3*N-2, N*(1+NB) )
+ LWORK = MAX( LWORK, 1 )
LDA = MAX( N, 1 )
XTYPE = 'N'
NIMAT = NTYPES
--- /dev/null
+*> \brief \b ZDRVHE_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZDRVHE_AA_2STAGE(
+* DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+* NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NOUT, NRHS
+* DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NVAL( * )
+* DOUBLE PRECISION RWORK( * )
+* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZDRVHE_AA_2STAGE tests the driver routine ZHESV_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand side vectors to be generated for
+*> each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is DOUBLE PRECISION
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16_lin
+*
+* =====================================================================
+ SUBROUTINE ZDRVHE_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+ $ RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NMAX, NN, NOUT, NRHS
+ DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NVAL( * )
+ DOUBLE PRECISION RWORK( * )
+ COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+ INTEGER NTYPES, NTESTS
+ PARAMETER ( NTYPES = 10, NTESTS = 3 )
+ INTEGER NFACT
+ PARAMETER ( NFACT = 2 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
+ CHARACTER*3 MATPATH, PATH
+ INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+ $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+ $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+ DOUBLE PRECISION ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER FACTS( NFACT ), UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ DOUBLE PRECISION RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DGET06, ZLANHE
+ EXTERNAL DGET06, ZLANHE
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX,
+ $ ZGET04, ZLACPY, ZLARHS, ZLATB4, ZLATMS,
+ $ ZHESV_AA_2STAGE, ZHET01_AA, ZPOT02,
+ $ ZHETRF_AA_2STAGE
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCMPLX, MAX, MIN
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Zomplex precision'
+ PATH( 2: 3 ) = 'H2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Zomplex precision'
+ MATPATH( 2: 3 ) = 'HE'
+*
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL ZERRVX( PATH, NOUT )
+ INFOT = 0
+*
+* Set the block size and minimum block size for testing.
+*
+ NB = 1
+ NBMIN = 2
+ CALL XLAENV( 1, NB )
+ CALL XLAENV( 2, NBMIN )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+* Set up parameters with ZLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+ $ MODE, CNDNUM, DIST )
+*
+* Generate a matrix with ZLATMS.
+*
+ SRNAMT = 'ZLATMS'
+ CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+ $ WORK, INFO )
+*
+* Check error code from ZLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
+ $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+ GO TO 160
+ END IF
+*
+* For types 3-6, zero one or more rows and columns of
+* the matrix to test that INFO is returned correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = ZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = ZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = ZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IOFF = 0
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = ZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = ZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+*
+ DO 150 IFACT = 1, NFACT
+*
+* Do first for FACT = 'F', then for other values.
+*
+ FACT = FACTS( IFACT )
+*
+* Form an exact solution and set the right hand side.
+*
+ SRNAMT = 'ZLARHS'
+ CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+ $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+ $ INFO )
+ XTYPE = 'C'
+*
+* --- Test ZHESV_AA_2STAGE ---
+*
+ IF( IFACT.EQ.2 ) THEN
+ CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+* Factor the matrix and solve the system using ZHESV_AA.
+*
+ SRNAMT = 'ZHESV_AA_2STAGE '
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL ZHESV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ X, LDA, WORK, LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from ZHESV_AA .
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'ZHESV_AA', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
+ $ IMAT, NFAIL, NERRS, NOUT )
+ GO TO 120
+ ELSE IF( INFO.NE.0 ) THEN
+ GO TO 120
+ END IF
+*
+* Compute residual of the computed solution.
+*
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 1 ) )
+*
+* Reconstruct matrix from factors and compute
+* residual.
+*
+* NEED TO CREATE ZHET01_AA_2STAGE
+* CALL ZHET01_AA( UPLO, N, A, LDA, AFAC, LDA,
+* $ IWORK, AINV, LDA, RWORK,
+* $ RESULT( 2 ) )
+* NT = 2
+ NT = 1
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALADHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )'ZHESV_AA_2STAGE',
+ $ UPLO, N, IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+ 120 CONTINUE
+ END IF
+*
+ 150 CONTINUE
+*
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+ $ ', test ', I2, ', ratio =', G12.5 )
+ RETURN
+*
+* End of ZDRVHE_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_lin
*
$ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B,
$ COPYB, C, S, COPYS, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
DOUBLE PRECISION EPS, NORMA, NORMB, RCOND
* ..
* .. Local Arrays ..
- INTEGER ISEED( 4 ), ISEEDY( 4 ), IWORKQUERY
- DOUBLE PRECISION RESULT( NTESTS ), RWORKQUERY
- COMPLEX*16 WORKQUERY
+ INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ
+ DOUBLE PRECISION RESULT( NTESTS ), RWQ
+ COMPLEX*16 WQ
* ..
* .. Allocatable Arrays ..
COMPLEX*16, ALLOCATABLE :: WORK (:)
M = MMAX
N = NMAX
NRHS = NSMAX
- LDA = MAX( 1, M )
- LDB = MAX( 1, M, N )
MNMIN = MAX( MIN( M, N ), 1 )
*
* Compute workspace needed for routines
* ZQRT14, ZQRT17 (two side cases), ZQRT15 and ZQRT12
*
- LWORK = MAX( ( M+N )*NRHS,
+ LWORK = MAX( 1, ( M+N )*NRHS,
$ ( N+NRHS )*( M+2 ), ( M+NRHS )*( N+2 ),
$ MAX( M+MNMIN, NRHS*MNMIN,2*N+M ),
$ MAX( M*N+4*MNMIN+MAX(M,N), M*N+2*MNMIN+4*N ) )
+ LRWORK = 1
+ LIWORK = 1
+*
+* Iterate through all test cases and compute necessary workspace
+* sizes for ?GELS, ?GETSLS, ?GELSY, ?GELSS and ?GELSD routines.
+*
+ DO IM = 1, NM
+ M = MVAL( IM )
+ LDA = MAX( 1, M )
+ DO IN = 1, NN
+ N = NVAL( IN )
+ MNMIN = MAX(MIN( M, N ),1)
+ LDB = MAX( 1, M, N )
+ DO INS = 1, NNS
+ NRHS = NSVAL( INS )
+ DO IRANK = 1, 2
+ DO ISCALE = 1, 3
+ ITYPE = ( IRANK-1 )*3 + ISCALE
+ IF( DOTYPE( ITYPE ) ) THEN
+ IF( IRANK.EQ.1 ) THEN
+ DO ITRAN = 1, 2
+ IF( ITRAN.EQ.1 ) THEN
+ TRANS = 'N'
+ ELSE
+ TRANS = 'C'
+ END IF
+*
+* Compute workspace needed for ZGELS
+ CALL ZGELS( TRANS, M, N, NRHS, A, LDA,
+ $ B, LDB, WQ, -1, INFO )
+ LWORK_ZGELS = INT ( WQ )
+* Compute workspace needed for ZGETSLS
+ CALL ZGETSLS( TRANS, M, N, NRHS, A, LDA,
+ $ B, LDB, WQ, -1, INFO )
+ LWORK_ZGETSLS = INT( WQ )
+ ENDDO
+ END IF
+* Compute workspace needed for ZGELSY
+ CALL ZGELSY( M, N, NRHS, A, LDA, B, LDB, IWQ,
+ $ RCOND, CRANK, WQ, -1, RWORK, INFO )
+ LWORK_ZGELSY = INT( WQ )
+ LRWORK_ZGELSY = 2*N
+* Compute workspace needed for ZGELSS
+ CALL ZGELSS( M, N, NRHS, A, LDA, B, LDB, S,
+ $ RCOND, CRANK, WQ, -1 , RWORK,
+ $ INFO )
+ LWORK_ZGELSS = INT( WQ )
+ LRWORK_ZGELSS = 5*MNMIN
+* Compute workspace needed for ZGELSD
+ CALL ZGELSD( M, N, NRHS, A, LDA, B, LDB, S,
+ $ RCOND, CRANK, WQ, -1, RWQ, IWQ,
+ $ INFO )
+ LWORK_ZGELSD = INT( WQ )
+ LRWORK_ZGELSD = INT( RWQ )
+* Compute LIWORK workspace needed for ZGELSY and ZGELSD
+ LIWORK = MAX( LIWORK, N, IWQ )
+* Compute LRWORK workspace needed for ZGELSY, ZGELSS and ZGELSD
+ LRWORK = MAX( LRWORK, LRWORK_ZGELSY,
+ $ LRWORK_ZGELSS, LRWORK_ZGELSD )
+* Compute LWORK workspace needed for all functions
+ LWORK = MAX( LWORK, LWORK_ZGELS, LWORK_ZGETSLS,
+ $ LWORK_ZGELSY, LWORK_ZGELSS,
+ $ LWORK_ZGELSD )
+ END IF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
*
-* Compute workspace needed for ZGELS
- CALL ZGELS( 'N', M, N, NRHS, A, LDA, B, LDB,
- $ WORKQUERY, -1, INFO )
- LWORK_ZGELS = INT ( WORKQUERY )
-* Compute workspace needed for ZGETSLS
- CALL ZGETSLS( 'N', M, N, NRHS, A, LDA, B, LDB,
- $ WORKQUERY, -1, INFO )
- LWORK_ZGETSLS = INT( WORKQUERY )
-* Compute workspace needed for ZGELSY
- CALL ZGELSY( M, N, NRHS, A, LDA, B, LDB, IWORKQUERY,
- $ RCOND, CRANK, WORKQUERY, -1, RWORK, INFO )
- LWORK_ZGELSY = INT( WORKQUERY )
- LRWORK_ZGELSY = 2*N
-* Compute workspace needed for ZGELSS
- CALL ZGELSS( M, N, NRHS, A, LDA, B, LDB, S,
- $ RCOND, CRANK, WORKQUERY, -1 , RWORK, INFO )
- LWORK_ZGELSS = INT( WORKQUERY )
- LRWORK_ZGELSS = 5*MNMIN
-* Compute workspace needed for ZGELSD
- CALL ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, CRANK,
- $ WORKQUERY, -1, RWORKQUERY, IWORKQUERY, INFO )
- LWORK_ZGELSD = INT( WORKQUERY )
- LRWORK_ZGELSD = INT( RWORKQUERY )
-* Compute LIWORK workspace needed for ZGELSY and ZGELSD
- LIWORK = MAX( 1, N, IWORKQUERY )
-* Compute LRWORK workspace needed for ZGELSY, ZGELSS and ZGELSD
- LRWORK = MAX( 1, LRWORK_ZGELSY, LRWORK_ZGELSS, LRWORK_ZGELSD )
-* Compute LWORK workspace needed for all functions
- LWORK = MAX( 1, LWORK, LWORK_ZGELS, LWORK_ZGETSLS, LWORK_ZGELSY,
- $ LWORK_ZGELSS, LWORK_ZGELSD )
LWLSY = LWORK
*
ALLOCATE( WORK( LWORK ) )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_lin
*
SUBROUTINE ZDRVRF3( NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2,
+ D_WORK_ZLANGE, Z_WORK_ZGEQRF, TAU )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, NN, NOUT
*
IF ( IALPHA.EQ. 1) THEN
ALPHA = ZERO
- ELSE IF ( IALPHA.EQ. 1) THEN
+ ELSE IF ( IALPHA.EQ. 2) THEN
ALPHA = ONE
ELSE
ALPHA = ZLARND( 4, ISEED )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_lin
*
SUBROUTINE ZDRVRF4( NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A,
+ LDA, D_WORK_ZLANGE )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER LDA, LDC, NN, NOUT
IF ( IALPHA.EQ. 1) THEN
ALPHA = ZERO
BETA = ZERO
- ELSE IF ( IALPHA.EQ. 1) THEN
+ ELSE IF ( IALPHA.EQ. 2) THEN
ALPHA = ONE
BETA = ZERO
- ELSE IF ( IALPHA.EQ. 1) THEN
+ ELSE IF ( IALPHA.EQ. 3) THEN
ALPHA = ZERO
BETA = ONE
ELSE
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
-*
-* @generated from LIN/ddrvsy_aa.f, fortran d -> z, Thu Nov 17 12:14:51 2016
+*> \date November 2017
*
*> \ingroup complex16_lin
*
$ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
$ RWORK, IWORK, NOUT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
LOGICAL TSTERR
EXTERNAL DGET06, ZLANSY
* ..
* .. External Subroutines ..
- EXTERNAL ALADHD, ALAERH, ALASVM, DERRVX, ZGET04, ZLACPY,
- $ ZLARHS, ZLASET, ZLATB4, ZLATMS, ZSYT02, DSYT05,
+ EXTERNAL ALADHD, ALAERH, ALASVM, ZERRVX, ZGET04, ZLACPY,
+ $ ZLARHS, ZLASET, ZLATB4, ZLATMS, ZSYT02,
$ ZSYSV_AA, ZSYT01_AA, ZSYTRF_AA, XLAENV
* ..
* .. Scalars in Common ..
DO 10 I = 1, 4
ISEED( I ) = ISEEDY( I )
10 CONTINUE
- LWORK = MAX( 2*NMAX, NMAX*NRHS )
*
* Test the error exits
*
*
DO 180 IN = 1, NN
N = NVAL( IN )
+ LWORK = MAX( 3*N-2, N*(1+NB) )
+ LWORK = MAX( LWORK, 1 )
LDA = MAX( N, 1 )
XTYPE = 'N'
NIMAT = NTYPES
--- /dev/null
+*> \brief \b ZDRVSY_AA_2STAGE
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZDRVSY_AA_2STAGE(
+* DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
+* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
+* NOUT )
+*
+* .. Scalar Arguments ..
+* LOGICAL TSTERR
+* INTEGER NMAX, NN, NOUT, NRHS
+* DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+* LOGICAL DOTYPE( * )
+* INTEGER IWORK( * ), NVAL( * )
+* DOUBLE PRECISION RWORK( * )
+* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+* $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZDRVSY_AA_2STAGE tests the driver routine ZSYSV_AA_2STAGE.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DOTYPE
+*> \verbatim
+*> DOTYPE is LOGICAL array, dimension (NTYPES)
+*> The matrix types to be used for testing. Matrices of type j
+*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
+*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
+*> \endverbatim
+*>
+*> \param[in] NN
+*> \verbatim
+*> NN is INTEGER
+*> The number of values of N contained in the vector NVAL.
+*> \endverbatim
+*>
+*> \param[in] NVAL
+*> \verbatim
+*> NVAL is INTEGER array, dimension (NN)
+*> The values of the matrix dimension N.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand side vectors to be generated for
+*> each linear system.
+*> \endverbatim
+*>
+*> \param[in] THRESH
+*> \verbatim
+*> THRESH is DOUBLE PRECISION
+*> The threshold value for the test ratios. A result is
+*> included in the output file if RESULT >= THRESH. To have
+*> every test ratio printed, use THRESH = 0.
+*> \endverbatim
+*>
+*> \param[in] TSTERR
+*> \verbatim
+*> TSTERR is LOGICAL
+*> Flag that indicates whether error exits are to be tested.
+*> \endverbatim
+*>
+*> \param[in] NMAX
+*> \verbatim
+*> NMAX is INTEGER
+*> The maximum value permitted for N, used in dimensioning the
+*> work arrays.
+*> \endverbatim
+*>
+*> \param[out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AFAC
+*> \verbatim
+*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] AINV
+*> \verbatim
+*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
+*> \endverbatim
+*>
+*> \param[out] B
+*> \verbatim
+*> B is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] X
+*> \verbatim
+*> X is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] XACT
+*> \verbatim
+*> XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS))
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is COMPLEX*16 array, dimension (NMAX+2*NRHS)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (NMAX)
+*> \endverbatim
+*>
+*> \param[in] NOUT
+*> \verbatim
+*> NOUT is INTEGER
+*> The unit number for output.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2017
+*
+*> \ingroup complex16_lin
+*
+* =====================================================================
+ SUBROUTINE ZDRVSY_AA_2STAGE(
+ $ DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
+ $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
+ $ RWORK, IWORK, NOUT )
+*
+* -- LAPACK test routine (version 3.8.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2017
+*
+* .. Scalar Arguments ..
+ LOGICAL TSTERR
+ INTEGER NMAX, NN, NOUT, NRHS
+ DOUBLE PRECISION THRESH
+* ..
+* .. Array Arguments ..
+ LOGICAL DOTYPE( * )
+ INTEGER IWORK( * ), NVAL( * )
+ DOUBLE PRECISION RWORK( * )
+ COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
+ $ WORK( * ), X( * ), XACT( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+ COMPLEX*16 CZERO
+ PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+ INTEGER NTYPES, NTESTS
+ PARAMETER ( NTYPES = 10, NTESTS = 3 )
+ INTEGER NFACT
+ PARAMETER ( NFACT = 2 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ZEROT
+ CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
+ CHARACTER*3 MATPATH, PATH
+ INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
+ $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
+ $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
+ DOUBLE PRECISION ANORM, CNDNUM
+* ..
+* .. Local Arrays ..
+ CHARACTER FACTS( NFACT ), UPLOS( 2 )
+ INTEGER ISEED( 4 ), ISEEDY( 4 )
+ DOUBLE PRECISION RESULT( NTESTS )
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DGET06, ZLANSY
+ EXTERNAL DGET06, ZLANSY
+* ..
+* .. External Subroutines ..
+ EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX,
+ $ ZGET04, ZLACPY, ZLARHS, ZLATB4, ZLATMS,
+ $ ZSYSV_AA_2STAGE, ZSYT01_AA, ZSYT02,
+ $ ZSYTRF_AA_2STAGE
+* ..
+* .. Scalars in Common ..
+ LOGICAL LERR, OK
+ CHARACTER*32 SRNAMT
+ INTEGER INFOT, NUNIT
+* ..
+* .. Common blocks ..
+ COMMON / INFOC / INFOT, NUNIT, OK, LERR
+ COMMON / SRNAMC / SRNAMT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CMPLX, MAX, MIN
+* ..
+* .. Data statements ..
+ DATA ISEEDY / 1988, 1989, 1990, 1991 /
+ DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
+* ..
+* .. Executable Statements ..
+*
+* Initialize constants and the random number seed.
+*
+* Test path
+*
+ PATH( 1: 1 ) = 'Zomplex precision'
+ PATH( 2: 3 ) = 'H2'
+*
+* Path to generate matrices
+*
+ MATPATH( 1: 1 ) = 'Zomplex precision'
+ MATPATH( 2: 3 ) = 'SY'
+*
+ NRUN = 0
+ NFAIL = 0
+ NERRS = 0
+ DO 10 I = 1, 4
+ ISEED( I ) = ISEEDY( I )
+ 10 CONTINUE
+*
+* Test the error exits
+*
+ IF( TSTERR )
+ $ CALL ZERRVX( PATH, NOUT )
+ INFOT = 0
+*
+* Set the block size and minimum block size for testing.
+*
+ NB = 1
+ NBMIN = 2
+ CALL XLAENV( 1, NB )
+ CALL XLAENV( 2, NBMIN )
+*
+* Do for each value of N in NVAL
+*
+ DO 180 IN = 1, NN
+ N = NVAL( IN )
+ LDA = MAX( N, 1 )
+ XTYPE = 'N'
+ NIMAT = NTYPES
+ IF( N.LE.0 )
+ $ NIMAT = 1
+*
+ DO 170 IMAT = 1, NIMAT
+*
+* Do the tests only if DOTYPE( IMAT ) is true.
+*
+ IF( .NOT.DOTYPE( IMAT ) )
+ $ GO TO 170
+*
+* Skip types 3, 4, 5, or 6 if the matrix size is too small.
+*
+ ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
+ IF( ZEROT .AND. N.LT.IMAT-2 )
+ $ GO TO 170
+*
+* Do first for UPLO = 'U', then for UPLO = 'L'
+*
+ DO 160 IUPLO = 1, 2
+ UPLO = UPLOS( IUPLO )
+*
+* Begin generate the test matrix A.
+*
+* Set up parameters with ZLATB4 for the matrix generator
+* based on the type of matrix to be generated.
+*
+ CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
+ $ MODE, CNDNUM, DIST )
+*
+* Generate a matrix with ZLATMS.
+*
+ SRNAMT = 'ZLATMS'
+ CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
+ $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
+ $ WORK, INFO )
+*
+* Check error code from ZLATMS and handle error.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N,
+ $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
+ GO TO 160
+ END IF
+*
+* For types 3-6, zero one or more rows and columns of
+* the matrix to test that INFO is returned correctly.
+*
+ IF( ZEROT ) THEN
+ IF( IMAT.EQ.3 ) THEN
+ IZERO = 1
+ ELSE IF( IMAT.EQ.4 ) THEN
+ IZERO = N
+ ELSE
+ IZERO = N / 2 + 1
+ END IF
+*
+ IF( IMAT.LT.6 ) THEN
+*
+* Set row and column IZERO to zero.
+*
+ IF( IUPLO.EQ.1 ) THEN
+ IOFF = ( IZERO-1 )*LDA
+ DO 20 I = 1, IZERO - 1
+ A( IOFF+I ) = CZERO
+ 20 CONTINUE
+ IOFF = IOFF + IZERO
+ DO 30 I = IZERO, N
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 30 CONTINUE
+ ELSE
+ IOFF = IZERO
+ DO 40 I = 1, IZERO - 1
+ A( IOFF ) = CZERO
+ IOFF = IOFF + LDA
+ 40 CONTINUE
+ IOFF = IOFF - IZERO
+ DO 50 I = IZERO, N
+ A( IOFF+I ) = CZERO
+ 50 CONTINUE
+ END IF
+ ELSE
+ IOFF = 0
+ IF( IUPLO.EQ.1 ) THEN
+*
+* Set the first IZERO rows and columns to zero.
+*
+ DO 70 J = 1, N
+ I2 = MIN( J, IZERO )
+ DO 60 I = 1, I2
+ A( IOFF+I ) = CZERO
+ 60 CONTINUE
+ IOFF = IOFF + LDA
+ 70 CONTINUE
+ IZERO = 1
+ ELSE
+*
+* Set the first IZERO rows and columns to zero.
+*
+ IOFF = 0
+ DO 90 J = 1, N
+ I1 = MAX( J, IZERO )
+ DO 80 I = I1, N
+ A( IOFF+I ) = CZERO
+ 80 CONTINUE
+ IOFF = IOFF + LDA
+ 90 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IZERO = 0
+ END IF
+*
+* End generate the test matrix A.
+*
+*
+ DO 150 IFACT = 1, NFACT
+*
+* Do first for FACT = 'F', then for other values.
+*
+ FACT = FACTS( IFACT )
+*
+* Form an exact solution and set the right hand side.
+*
+ SRNAMT = 'ZLARHS'
+ CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
+ $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
+ $ INFO )
+ XTYPE = 'C'
+*
+* --- Test ZSYSV_AA_2STAGE ---
+*
+ IF( IFACT.EQ.2 ) THEN
+ CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
+*
+* Factor the matrix and solve the system using ZSYSV_AA.
+*
+ SRNAMT = 'ZSYSV_AA_2STAGE '
+ LWORK = MIN(N*NB, 3*NMAX*NMAX)
+ CALL ZSYSV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA,
+ $ AINV, (3*NB+1)*N,
+ $ IWORK, IWORK( 1+N ),
+ $ X, LDA, WORK, LWORK, INFO )
+*
+* Adjust the expected value of INFO to account for
+* pivoting.
+*
+ IF( IZERO.GT.0 ) THEN
+ J = 1
+ K = IZERO
+ 100 CONTINUE
+ IF( J.EQ.K ) THEN
+ K = IWORK( J )
+ ELSE IF( IWORK( J ).EQ.K ) THEN
+ K = J
+ END IF
+ IF( J.LT.K ) THEN
+ J = J + 1
+ GO TO 100
+ END IF
+ ELSE
+ K = 0
+ END IF
+*
+* Check error code from ZSYSV_AA_2STAGE .
+*
+ IF( INFO.NE.K ) THEN
+ CALL ALAERH( PATH, 'ZSYSV_AA_2STAGE', INFO, K,
+ $ UPLO, N, N, -1, -1, NRHS,
+ $ IMAT, NFAIL, NERRS, NOUT )
+ GO TO 120
+ ELSE IF( INFO.NE.0 ) THEN
+ GO TO 120
+ END IF
+*
+* Compute residual of the computed solution.
+*
+ CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
+ CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
+ $ LDA, RWORK, RESULT( 1 ) )
+*
+* Reconstruct matrix from factors and compute
+* residual.
+*
+c CALL ZSY01_AA( UPLO, N, A, LDA, AFAC, LDA,
+c $ IWORK, AINV, LDA, RWORK,
+c $ RESULT( 2 ) )
+c NT = 2
+ NT = 1
+*
+* Print information about the tests that did not pass
+* the threshold.
+*
+ DO 110 K = 1, NT
+ IF( RESULT( K ).GE.THRESH ) THEN
+ IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
+ $ CALL ALADHD( NOUT, PATH )
+ WRITE( NOUT, FMT = 9999 )'ZSYSV_AA_2STAGE ',
+ $ UPLO, N, IMAT, K, RESULT( K )
+ NFAIL = NFAIL + 1
+ END IF
+ 110 CONTINUE
+ NRUN = NRUN + NT
+ 120 CONTINUE
+ END IF
+*
+ 150 CONTINUE
+*
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+*
+* Print a summary of the results.
+*
+ CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
+*
+ 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
+ $ ', test ', I2, ', ratio =', G12.5 )
+ RETURN
+*
+* End of ZDRVSY_AA_2STAGE
+*
+ END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_lin
*
* =====================================================================
SUBROUTINE ZERRHE( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
* .. External Subroutines ..
EXTERNAL ALAESM, CHKXER, ZHECON, ZHECON_3, ZHECON_ROOK,
$ ZHERFS, ZHETF2, ZHETF2_RK, ZHETF2_ROOK, ZHETRF,
- $ ZHETRF_RK, ZHETRF_ROOK, ZHETRF_AA, ZHETRI,
+ $ ZHETRF_RK, ZHETRF_ROOK, ZHETRF_AA,
+ $ ZHETRF_AA_2STAGE, ZHETRI,
$ ZHETRI_3, ZHETRI_3X, ZHETRI_ROOK, ZHETRI2,
$ ZHETRI2X, ZHETRS, ZHETRS_3, ZHETRS_ROOK,
- $ ZHETRS_AA, ZHPCON, ZHPRFS, ZHPTRF, ZHPTRI,
- $ ZHPTRS
+ $ ZHETRS_AA, ZHETRS_AA_2STAGE, ZHPCON, ZHPRFS,
+ $ ZHPTRF, ZHPTRI, ZHPTRS
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
INFOT = 10
CALL ZHETRS_AA( 'U', 0, 1, A, 1, IP, B, 1, W, -2, INFO )
CALL CHKXER( 'ZHETRS_AA', INFOT, NOUT, LERR, OK )
+*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* Test error exits of the routines that use factorization
+* of a symmetric indefinite matrix with Aasen's algorithm.
+*
+* ZHETRF_AA_2STAGE
+*
+ SRNAMT = 'ZHETRF_AA_2STAGE'
+ INFOT = 1
+ CALL ZHETRF_AA_2STAGE( '/', 0, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'ZHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZHETRF_AA_2STAGE( 'U', -1, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'ZHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL ZHETRF_AA_2STAGE( 'U', 2, A, 1, A, 2, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'ZHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 6
+ CALL ZHETRF_AA_2STAGE( 'U', 2, A, 2, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'ZHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 10
+ CALL ZHETRF_AA_2STAGE( 'U', 2, A, 2, A, 8, IP, IP, W, 0,
+ $ INFO )
+ CALL CHKXER( 'ZHETRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
+* ZHETRS_AA_2STAGE
+*
+ SRNAMT = 'ZHETRS_AA_2STAGE'
+ INFOT = 1
+ CALL ZHETRS_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZHETRS_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL ZHETRS_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL ZHETRS_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL ZHETRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL ZHETRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZHETRS_AA_STAGE', INFOT, NOUT, LERR, OK )
*
ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_lin
*
* =====================================================================
SUBROUTINE ZERRSY( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
$ ZSPTRS, ZSYCON, ZSYCON_3, ZSYCON_ROOK, ZSYRFS,
$ ZSYTF2, ZSYTF2_RK, ZSYTF2_ROOK, ZSYTRF,
$ ZSYTRF_RK, ZSYTRF_ROOK, ZSYTRI, ZSYTRI_3,
- $ ZSYTRI_3X, ZSYTRI_ROOK, ZSYTRI2, ZSYTRI2Z,
+ $ ZSYTRI_3X, ZSYTRI_ROOK, ZSYTRI2, ZSYTRI2X,
$ ZSYTRS, ZSYTRS_3, ZSYTRS_ROOK
* ..
* .. Scalars in Common ..
CALL ZSYTRS_AA( 'U', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
CALL CHKXER( 'ZSYTRS_AA', INFOT, NOUT, LERR, OK )
*
+ ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN
+*
+* Test error exits of the routines that use factorization
+* of a symmetric indefinite matrix with Aasen's algorithm.
+*
+* ZSYTRF_AA_2STAGE
+*
+ SRNAMT = 'ZSYTRF_AA_2STAGE'
+ INFOT = 1
+ CALL ZSYTRF_AA_2STAGE( '/', 0, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'ZSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZSYTRF_AA_2STAGE( 'U', -1, A, 1, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'ZSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 4
+ CALL ZSYTRF_AA_2STAGE( 'U', 2, A, 1, A, 2, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'ZSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 6
+ CALL ZSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 1, IP, IP, W, 1,
+ $ INFO )
+ CALL CHKXER( 'ZSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 10
+ CALL ZSYTRF_AA_2STAGE( 'U', 2, A, 2, A, 8, IP, IP, W, 0,
+ $ INFO )
+ CALL CHKXER( 'ZSYTRF_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
+* CHETRS_AA_2STAGE
+*
+ SRNAMT = 'ZSYTRS_AA_2STAGE'
+ INFOT = 1
+ CALL ZSYTRS_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZSYTRS_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL ZSYTRS_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL ZSYTRS_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL ZSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZSYTRS_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL ZSYTRS_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP,
+ $ B, 1, INFO )
+ CALL CHKXER( 'ZSYTRS_AA_STAGE', INFOT, NOUT, LERR, OK )
+*
END IF
*
* Print a summary line.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_lin
*
* =====================================================================
SUBROUTINE ZERRVX( PATH, NUNIT )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
$ ZHPSV, ZHPSVX, ZPBSV, ZPBSVX, ZPOSV, ZPOSVX,
$ ZPPSV, ZPPSVX, ZPTSV, ZPTSVX, ZSPSV, ZSPSVX,
$ ZSYSV, ZSYSV_AA, ZSYSV_RK, ZSYSV_ROOK,
- $ ZSYSVX
+ $ ZSYSVX, ZSYSV_AA_2STAGE
* ..
* .. Scalars in Common ..
LOGICAL LERR, OK
CALL ZHESV_AA( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
CALL CHKXER( 'ZHESV_AA', INFOT, NOUT, LERR, OK )
*
+ ELSE IF( LSAMEN( 2, C2, 'H2' ) ) THEN
+*
+* CHESV_AASEN_2STAGE
+*
+ SRNAMT = 'ZHESV_AA_2STAGE'
+ INFOT = 1
+ CALL ZHESV_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'ZHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 2
+ CALL ZHESV_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'ZHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 3
+ CALL ZHESV_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'ZHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 5
+ CALL ZHESV_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'ZHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 11
+ CALL ZHESV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1,
+ $ W, 1, INFO )
+ CALL CHKXER( 'ZHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+ INFOT = 7
+ CALL ZHESV_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP, B, 2,
+ $ W, 1, INFO )
+ CALL CHKXER( 'ZHESV_AA_2STAGE', INFOT, NOUT, LERR, OK )
+*
ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
*
* ZHPSV
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_lin
*
SUBROUTINE ZHET01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
$ LDC, RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
* Definition:
* ===========
*
-* SUBROUTINE ZLAHILB(N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
+* SUBROUTINE ZLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
* INFO, PATH)
*
* .. Scalar Arguments ..
*>
*> \param[in] NRHS
*> \verbatim
-*> NRHS is NRHS
+*> NRHS is INTEGER
*> The requested number of right-hand sides.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_lin
*
* =====================================================================
- SUBROUTINE ZLAHILB(N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
+ SUBROUTINE ZLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
$ INFO, PATH)
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
INTEGER N, NRHS, LDA, LDX, LDB, INFO
END DO
*
* Generate the scaled Hilbert matrix in A
-* If we are testing SY routines, take D1_i = D2_i, else, D1_i = D2_i*
+* If we are testing SY routines,
+* take D1_i = D2_i, else, D1_i = D2_i*
IF ( LSAMEN( 2, C2, 'SY' ) ) THEN
DO J = 1, N
DO I = 1, N
WORK(J) = ( ( (WORK(J-1)/(J-1)) * (J-1 - N) ) /(J-1) )
$ * (N +J -1)
END DO
-*
-* If we are testing SY routines, take D1_i = D2_i, else, D1_i = D2_i*
+
+* If we are testing SY routines,
+* take D1_i = D2_i, else, D1_i = D2_i*
IF ( LSAMEN( 2, C2, 'SY' ) ) THEN
DO J = 1, NRHS
DO I = 1, N
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
-*> < 0: if INFO = -k, the k-th argument had an illegal value
+*> < 0: if INFO = -i, the i-th argument had an illegal value
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_lin
*
SUBROUTINE ZLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
$ A, LDA, X, LDX, B, LDB, ISEED, INFO )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER TRANS, UPLO, XTYPE
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date June 2017
*
*> \ingroup complex16_lin
*
SUBROUTINE ZSYT01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
$ LDC, RWORK, RESID )
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* June 2017
*
* .. Scalar Arguments ..
CHARACTER UPLO
# This is the makefile to create a library of the test matrix
# generators used in LAPACK. The files are organized as follows:
#
-# SCATGEN -- Auxiliary routines called from both REAL and COMPLEX
-# DZATGEN -- Auxiliary routines called from both DOUBLE PRECISION
-# and COMPLEX*16
+# SCATGEN -- Auxiliary routines called from single precision
+# DZATGEN -- Auxiliary routines called from double precision
# SMATGEN -- Single precision real matrix generation routines
# CMATGEN -- Single precision complex matrix generation routines
# DMATGEN -- Double precision real matrix generation routines
# ZMATGEN -- Double precision complex matrix generation routines
#
-# The library can be set up to include routines for any combination
-# of the four precisions. To create or add to the library, enter make
-# followed by one or more of the precisions desired. Some examples:
-# make single
-# make single complex
-# make single double complex complex16
-# Alternatively, the command
-# make
-# without any arguments creates a library of all four precisions.
-# The library is called
-# tmglib.a
-# and is created at the LAPACK directory level.
-#
-# To remove the object files after the library is created, enter
-# make clean
-# On some systems, you can force the source files to be recompiled by
-# entering (for example)
-# make single FRC=FRC
-#
#######################################################################
-set(SCATGEN slatm1.f slaran.f slarnd.f)
+set(SCATGEN slatm1.f slatm7.f slaran.f slarnd.f)
set(SMATGEN slatms.f slatme.f slatmr.f slatmt.f
slagge.f slagsy.f slakf2.f slarge.f slaror.f slarot.f slatm2.f
- slatm3.f slatm5.f slatm6.f slatm7.f slahilb.f)
+ slatm3.f slatm5.f slatm6.f slahilb.f)
set(CMATGEN clatms.f clatme.f clatmr.f clatmt.f
clagge.f claghe.f clagsy.f clakf2.f clarge.f claror.f clarot.f
- clatm1.f clarnd.f clatm2.f clatm3.f clatm5.f clatm6.f clahilb.f slatm7.f)
+ clatm1.f clarnd.f clatm2.f clatm3.f clatm5.f clatm6.f clahilb.f)
-set(DZATGEN dlatm1.f dlaran.f dlarnd.f)
+set(DZATGEN dlatm1.f dlatm7.f dlaran.f dlarnd.f)
set(DMATGEN dlatms.f dlatme.f dlatmr.f dlatmt.f
dlagge.f dlagsy.f dlakf2.f dlarge.f dlaror.f dlarot.f dlatm2.f
- dlatm3.f dlatm5.f dlatm6.f dlatm7.f dlahilb.f)
+ dlatm3.f dlatm5.f dlatm6.f dlahilb.f)
set(ZMATGEN zlatms.f zlatme.f zlatmr.f zlatmt.f
zlagge.f zlaghe.f zlagsy.f zlakf2.f zlarge.f zlaror.f zlarot.f
- zlatm1.f zlarnd.f zlatm2.f zlatm3.f zlatm5.f zlatm6.f zlahilb.f dlatm7.f)
+ zlatm1.f zlarnd.f zlatm2.f zlatm3.f zlatm5.f zlatm6.f zlahilb.f)
+
+set(SOURCES)
if(BUILD_SINGLE)
- set(ALLOBJ ${SMATGEN} ${SCATGEN})
+ list(APPEND SOURCES ${SMATGEN} ${SCATGEN})
endif()
if(BUILD_DOUBLE)
- set(ALLOBJ ${ALLOBJ} ${DMATGEN} ${DZATGEN})
+ list(APPEND SOURCES ${DMATGEN} ${DZATGEN})
endif()
if(BUILD_COMPLEX)
- set(ALLOBJ ${ALLOBJ} ${CMATGEN} ${SCATGEN})
+ list(APPEND SOURCES ${CMATGEN} ${SCATGEN})
endif()
if(BUILD_COMPLEX16)
- set(ALLOBJ ${ALLOBJ} ${ZMATGEN} ${DZATGEN})
+ list(APPEND SOURCES ${ZMATGEN} ${DZATGEN})
endif()
+list(REMOVE_DUPLICATES SOURCES)
-if(NOT ALLOBJ)
- set(ALLOBJ ${SMATGEN} ${CMATGEN} ${SCATGEN} ${DMATGEN} ${ZMATGEN}
- ${DZATGEN})
-else()
- list(REMOVE_DUPLICATES ALLOBJ)
-endif()
-add_library(tmglib ${ALLOBJ})
-target_link_libraries(tmglib ${LAPACK_LIBRARIES})
+add_library(tmglib ${SOURCES})
+target_link_libraries(tmglib ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
lapack_install_library(tmglib)
# This is the makefile to create a library of the test matrix
# generators used in LAPACK. The files are organized as follows:
#
-# SCATGEN -- Auxiliary routines called from both REAL and COMPLEX
-# DZATGEN -- Auxiliary routines called from both DOUBLE PRECISION
-# and COMPLEX*16
+# SCATGEN -- Auxiliary routines called from single precision
+# DZATGEN -- Auxiliary routines called from double precision
# SMATGEN -- Single precision real matrix generation routines
# CMATGEN -- Single precision complex matrix generation routines
# DMATGEN -- Double precision real matrix generation routines
# and is created at the LAPACK directory level.
#
# To remove the object files after the library is created, enter
-# make clean
+# make cleanobj
# On some systems, you can force the source files to be recompiled by
# entering (for example)
# make single FRC=FRC
#
#######################################################################
-SCATGEN = slatm1.o slaran.o slarnd.o
+SCATGEN = slatm1.o slatm7.o slaran.o slarnd.o
SMATGEN = slatms.o slatme.o slatmr.o slatmt.o \
slagge.o slagsy.o slakf2.o slarge.o slaror.o slarot.o slatm2.o \
- slatm3.o slatm5.o slatm6.o slatm7.o slahilb.o
+ slatm3.o slatm5.o slatm6.o slahilb.o
CMATGEN = clatms.o clatme.o clatmr.o clatmt.o \
clagge.o claghe.o clagsy.o clakf2.o clarge.o claror.o clarot.o \
clatm1.o clarnd.o clatm2.o clatm3.o clatm5.o clatm6.o clahilb.o
-DZATGEN = dlatm1.o dlaran.o dlarnd.o
+DZATGEN = dlatm1.o dlatm7.o dlaran.o dlarnd.o
DMATGEN = dlatms.o dlatme.o dlatmr.o dlatmt.o \
dlagge.o dlagsy.o dlakf2.o dlarge.o dlaror.o dlarot.o dlatm2.o \
- dlatm3.o dlatm5.o dlatm6.o dlatm7.o dlahilb.o
+ dlatm3.o dlatm5.o dlatm6.o dlahilb.o
ZMATGEN = zlatms.o zlatme.o zlatmr.o zlatmt.o \
zlagge.o zlaghe.o zlagsy.o zlakf2.o zlarge.o zlaror.o zlarot.o \
$(DZATGEN)
../../$(TMGLIB): $(ALLOBJ)
- $(ARCH) $(ARCHFLAGS) $@ $(ALLOBJ)
+ $(ARCH) $(ARCHFLAGS) $@ $^
$(RANLIB) $@
single: $(SMATGEN) $(SCATGEN)
- $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $(SMATGEN) $(SCATGEN)
+ $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $^
$(RANLIB) ../../$(TMGLIB)
complex: $(CMATGEN) $(SCATGEN)
- $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $(CMATGEN) $(SCATGEN)
+ $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $^
$(RANLIB) ../../$(TMGLIB)
double: $(DMATGEN) $(DZATGEN)
- $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $(DMATGEN) $(DZATGEN)
+ $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $^
$(RANLIB) ../../$(TMGLIB)
complex16: $(ZMATGEN) $(DZATGEN)
- $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $(ZMATGEN) $(DZATGEN)
+ $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $^
$(RANLIB) ../../$(TMGLIB)
$(SCATGEN): $(FRC)
FRC:
@FRC=$(FRC)
-clean:
+clean: cleanobj #cleanlib
+cleanobj:
rm -f *.o
+cleanlib:
+ rm -f ../../$(TMGLIB)
.f.o:
$(FORTRAN) $(OPTS) -c -o $@ $<
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex_matgen
*
SUBROUTINE CLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
$ INFO, PATH)
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER N, NRHS, LDA, LDX, LDB, INFO
INTEGER I, J
COMPLEX TMP
CHARACTER*2 C2
-
+* ..
* .. Parameters ..
* NMAX_EXACT the largest dimension where the generated data is
* exact.
* ??? complex uses how many bits ???
INTEGER NMAX_EXACT, NMAX_APPROX, SIZE_D
PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11, SIZE_D = 8)
-
+*
* d's are generated from random permuation of those eight elements.
COMPLEX D1(8), D2(8), INVD1(8), INVD2(8)
DATA D1 /(-1,0),(0,1),(-1,-1),(0,-1),(1,0),(-1,1),(1,1),(1,-1)/
$ (-.5,-.5),(.5,-.5),(.5,.5)/
DATA INVD2 /(-1,0),(0,1),(-.5,-.5),(0,-1),(1,0),
$ (-.5,.5),(.5,.5),(.5,-.5)/
-
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
* ..
* .. External Functions
EXTERNAL CLASET, LSAMEN
IF (N .GT. NMAX_EXACT) THEN
INFO = 1
END IF
-
+*
* Compute M = the LCM of the integers [1, 2*N-1]. The largest
* reasonable N is small enough that integers suffice (up to N = 11).
M = 1
END DO
M = (M / TI) * I
END DO
-
+*
* Generate the scaled Hilbert matrix in A
* If we are testing SY routines, take
* D1_i = D2_i, else, D1_i = D2_i*
END DO
END DO
END IF
-
+*
* Generate matrix B as simply the first NRHS columns of M * the
* identity.
TMP = REAL(M)
CALL CLASET('Full', N, NRHS, (0.0,0.0), TMP, B, LDB)
-
+*
* Generate the true solutions in X. Because B = the first NRHS
* columns of M*I, the true solutions are just the first NRHS columns
* of the inverse Hilbert matrix.
-C> \brief \b DLAHILB
+*> \brief \b DLAHILB
*
* =========== DOCUMENTATION ===========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup double_matgen
*
* =====================================================================
SUBROUTINE DLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER N, NRHS, LDA, LDX, LDB, INFO
INTEGER TM, TI, R
INTEGER M
INTEGER I, J
-
+* ..
* .. Parameters ..
* NMAX_EXACT the largest dimension where the generated data is
* exact.
* a small componentwise relative error.
INTEGER NMAX_EXACT, NMAX_APPROX
PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11)
-
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
* ..
* .. External Functions
EXTERNAL DLASET
IF (N .GT. NMAX_EXACT) THEN
INFO = 1
END IF
-
+*
* Compute M = the LCM of the integers [1, 2*N-1]. The largest
* reasonable N is small enough that integers suffice (up to N = 11).
M = 1
END DO
M = (M / TI) * I
END DO
-
+*
* Generate the scaled Hilbert matrix in A
DO J = 1, N
DO I = 1, N
A(I, J) = DBLE(M) / (I + J - 1)
END DO
END DO
-
+*
* Generate matrix B as simply the first NRHS columns of M * the
* identity.
CALL DLASET('Full', N, NRHS, 0.0D+0, DBLE(M), B, LDB)
WORK(J) = ( ( (WORK(J-1)/(J-1)) * (J-1 - N) ) /(J-1) )
$ * (N +J -1)
END DO
-
+*
DO J = 1, NRHS
DO I = 1, N
X(I, J) = (WORK(I)*WORK(J)) / (I + J - 1)
END DO
END DO
-
+*
END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup real_matgen
*
* =====================================================================
SUBROUTINE SLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER N, NRHS, LDA, LDX, LDB, INFO
INTEGER TM, TI, R
INTEGER M
INTEGER I, J
-
+* ..
* .. Parameters ..
* NMAX_EXACT the largest dimension where the generated data is
* exact.
* a small componentwise relative error.
INTEGER NMAX_EXACT, NMAX_APPROX
PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11)
-
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
* ..
* .. External Functions
EXTERNAL SLASET
IF (N .GT. NMAX_EXACT) THEN
INFO = 1
END IF
-
+*
* Compute M = the LCM of the integers [1, 2*N-1]. The largest
* reasonable N is small enough that integers suffice (up to N = 11).
M = 1
END DO
M = (M / TI) * I
END DO
-
+*
* Generate the scaled Hilbert matrix in A
DO J = 1, N
DO I = 1, N
A(I, J) = REAL(M) / (I + J - 1)
END DO
END DO
-
+*
* Generate matrix B as simply the first NRHS columns of M * the
* identity.
CALL SLASET('Full', N, NRHS, 0.0, REAL(M), B, LDB)
-
+*
* Generate the true solutions in X. Because B = the first NRHS
* columns of M*I, the true solutions are just the first NRHS columns
* of the inverse Hilbert matrix.
WORK(J) = ( ( (WORK(J-1)/(J-1)) * (J-1 - N) ) /(J-1) )
$ * (N +J -1)
END DO
-
+*
DO J = 1, NRHS
DO I = 1, N
X(I, J) = (WORK(I)*WORK(J)) / (I + J - 1)
END DO
END DO
-
+*
END
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date December 2016
+*> \date November 2017
*
*> \ingroup complex16_matgen
*
SUBROUTINE ZLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
$ INFO, PATH)
*
-* -- LAPACK test routine (version 3.7.0) --
+* -- LAPACK test routine (version 3.8.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* December 2016
+* November 2017
*
* .. Scalar Arguments ..
INTEGER N, NRHS, LDA, LDX, LDB, INFO
INTEGER I, J
COMPLEX*16 TMP
CHARACTER*2 C2
-
+* ..
* .. Parameters ..
* NMAX_EXACT the largest dimension where the generated data is
* exact.
* ??? complex uses how many bits ???
INTEGER NMAX_EXACT, NMAX_APPROX, SIZE_D
PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11, SIZE_D = 8)
-
+*
* d's are generated from random permuation of those eight elements.
COMPLEX*16 d1(8), d2(8), invd1(8), invd2(8)
DATA D1 /(-1,0),(0,1),(-1,-1),(0,-1),(1,0),(-1,1),(1,1),(1,-1)/
DATA INVD2 /(-1,0),(0,1),(-.5,-.5),(0,-1),(1,0),
$ (-.5,.5),(.5,.5),(.5,-.5)/
* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* ..
* .. External Functions
EXTERNAL ZLASET, LSAMEN
INTRINSIC DBLE
IF (N .GT. NMAX_EXACT) THEN
INFO = 1
END IF
-
+*
* Compute M = the LCM of the integers [1, 2*N-1]. The largest
* reasonable N is small enough that integers suffice (up to N = 11).
M = 1
END DO
M = (M / TI) * I
END DO
-
+*
* Generate the scaled Hilbert matrix in A
* If we are testing SY routines,
* take D1_i = D2_i, else, D1_i = D2_i*
END DO
END DO
END IF
-
+*
* Generate matrix B as simply the first NRHS columns of M * the
* identity.
TMP = DBLE(M)
CALL ZLASET('Full', N, NRHS, (0.0D+0,0.0D+0), TMP, B, LDB)
-
+*
* Generate the true solutions in X. Because B = the first NRHS
* columns of M*I, the true solutions are just the first NRHS columns
* of the inverse Hilbert matrix.
# The executable files are called:
# xlintsts, xlintstd, xlintstc, and xlintstz for LIN
# xeigtsts, xeigtstd, xeigtstc, and xeigtstz for EIG
-# and exist in the current directory level.
#
# To remove the output files after the tests have been run, enter
-# make clean
+# make cleantest
#
# To re-run specific tests after a make, enter (for example):
# 'rm ssvd.out; make' or:
include ../make.inc
-ifneq ($(strip $(VARLIB)),)
- LAPACKLIB := $(VARLIB) ../$(LAPACKLIB)
-endif
-
-
all: single complex double complex16 singleproto doubleproto complexproto complex16proto
SEIGTST= snep.out \
#
# ======== SINGLE LIN TESTS ===========================
-stest.out: stest.in xlintsts
+stest.out: stest.in LIN/xlintsts
@echo Testing REAL LAPACK linear equation routines
- ./xlintsts < stest.in > $@ 2>&1
+ ./LIN/xlintsts < $< > $@ 2>&1
#
# ======== COMPLEX LIN TESTS ==========================
-ctest.out: ctest.in xlintstc
+ctest.out: ctest.in LIN/xlintstc
@echo Testing COMPLEX LAPACK linear equation routines
- ./xlintstc < ctest.in > $@ 2>&1
+ ./LIN/xlintstc < $< > $@ 2>&1
#
# ======== DOUBLE LIN TESTS ===========================
-dtest.out: dtest.in xlintstd
+dtest.out: dtest.in LIN/xlintstd
@echo Testing DOUBLE PRECISION LAPACK linear equation routines
- ./xlintstd < dtest.in > $@ 2>&1
+ ./LIN/xlintstd < $< > $@ 2>&1
#
# ======== COMPLEX16 LIN TESTS ========================
-ztest.out: ztest.in xlintstz
+ztest.out: ztest.in LIN/xlintstz
@echo Testing COMPLEX16 LAPACK linear equation routines
- ./xlintstz < ztest.in > $@ 2>&1
+ ./LIN/xlintstz < $< > $@ 2>&1
#
# ======== SINGLE-DOUBLE PROTO LIN TESTS ==============
-dstest.out: dstest.in xlintstds
+dstest.out: dstest.in LIN/xlintstds
@echo Testing SINGLE-DOUBLE PRECISION LAPACK prototype linear equation routines
- ./xlintstds < dstest.in > $@ 2>&1
+ ./LIN/xlintstds < $< > $@ 2>&1
#
# ======== COMPLEX-COMPLEX16 LIN TESTS ========================
-zctest.out: zctest.in xlintstzc
+zctest.out: zctest.in LIN/xlintstzc
@echo Testing COMPLEX-COMPLEX16 LAPACK prototype linear equation routines
- ./xlintstzc < zctest.in > $@ 2>&1
+ ./LIN/xlintstzc < $< > $@ 2>&1
#
# ======== SINGLE RFP LIN TESTS ========================
-stest_rfp.out: stest_rfp.in xlintstrfs
+stest_rfp.out: stest_rfp.in LIN/xlintstrfs
@echo Testing REAL LAPACK RFP prototype linear equation routines
- ./xlintstrfs < stest_rfp.in > $@ 2>&1
+ ./LIN/xlintstrfs < $< > $@ 2>&1
#
# ======== COMPLEX16 RFP LIN TESTS ========================
-dtest_rfp.out: dtest_rfp.in xlintstrfd
+dtest_rfp.out: dtest_rfp.in LIN/xlintstrfd
@echo Testing DOUBLE PRECISION LAPACK RFP prototype linear equation routines
- ./xlintstrfd < dtest_rfp.in > $@ 2>&1
+ ./LIN/xlintstrfd < $< > $@ 2>&1
#
# ======== COMPLEX16 RFP LIN TESTS ========================
-ctest_rfp.out: ctest_rfp.in xlintstrfc
+ctest_rfp.out: ctest_rfp.in LIN/xlintstrfc
@echo Testing COMPLEX LAPACK RFP prototype linear equation routines
- ./xlintstrfc < ctest_rfp.in > $@ 2>&1
+ ./LIN/xlintstrfc < $< > $@ 2>&1
#
# ======== COMPLEX16 RFP LIN TESTS ========================
-ztest_rfp.out: ztest_rfp.in xlintstrfz
+ztest_rfp.out: ztest_rfp.in LIN/xlintstrfz
@echo Testing COMPLEX16 LAPACK RFP prototype linear equation routines
- ./xlintstrfz < ztest_rfp.in > $@ 2>&1
+ ./LIN/xlintstrfz < $< > $@ 2>&1
#
#
# ======== SINGLE EIG TESTS ===========================
#
-snep.out: nep.in xeigtsts
+snep.out: nep.in EIG/xeigtsts
@echo NEP: Testing Nonsymmetric Eigenvalue Problem routines
- ./xeigtsts < nep.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-ssep.out: sep.in xeigtsts
+ssep.out: sep.in EIG/xeigtsts
@echo SEP: Testing Symmetric Eigenvalue Problem routines
- ./xeigtsts < sep.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sse2.out: se2.in xeigtsts
+sse2.out: se2.in EIG/xeigtsts
@echo SEP: Testing Symmetric Eigenvalue Problem routines
- ./xeigtsts < se2.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-ssvd.out: svd.in xeigtsts
+ssvd.out: svd.in EIG/xeigtsts
@echo SVD: Testing Singular Value Decomposition routines
- ./xeigtsts < svd.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sec.out: sec.in xeigtsts
+sec.out: sec.in EIG/xeigtsts
@echo SEC: Testing REAL Eigen Condition Routines
- ./xeigtsts < sec.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sed.out: sed.in xeigtsts
+sed.out: sed.in EIG/xeigtsts
@echo SEV: Testing REAL Nonsymmetric Eigenvalue Driver
- ./xeigtsts < sed.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sgg.out: sgg.in xeigtsts
+sgg.out: sgg.in EIG/xeigtsts
@echo SGG: Testing REAL Nonsymmetric Generalized Eigenvalue Problem routines
- ./xeigtsts < sgg.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sgd.out: sgd.in xeigtsts
+sgd.out: sgd.in EIG/xeigtsts
@echo SGD: Testing REAL Nonsymmetric Generalized Eigenvalue Problem driver routines
- ./xeigtsts < sgd.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-ssb.out: ssb.in xeigtsts
+ssb.out: ssb.in EIG/xeigtsts
@echo SSB: Testing REAL Symmetric Eigenvalue Problem routines
- ./xeigtsts < ssb.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-ssg.out: ssg.in xeigtsts
+ssg.out: ssg.in EIG/xeigtsts
@echo SSG: Testing REAL Symmetric Generalized Eigenvalue Problem routines
- ./xeigtsts < ssg.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sbal.out: sbal.in xeigtsts
+sbal.out: sbal.in EIG/xeigtsts
@echo SGEBAL: Testing the balancing of a REAL general matrix
- ./xeigtsts < sbal.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sbak.out: sbak.in xeigtsts
+sbak.out: sbak.in EIG/xeigtsts
@echo SGEBAK: Testing the back transformation of a REAL balanced matrix
- ./xeigtsts < sbak.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sgbal.out: sgbal.in xeigtsts
+sgbal.out: sgbal.in EIG/xeigtsts
@echo SGGBAL: Testing the balancing of a pair of REAL general matrices
- ./xeigtsts < sgbal.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sgbak.out: sgbak.in xeigtsts
+sgbak.out: sgbak.in EIG/xeigtsts
@echo SGGBAK: Testing the back transformation of a pair of REAL balanced matrices
- ./xeigtsts < sgbak.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sbb.out: sbb.in xeigtsts
+sbb.out: sbb.in EIG/xeigtsts
@echo SBB: Testing banded Singular Value Decomposition routines
- ./xeigtsts < sbb.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sglm.out: glm.in xeigtsts
+sglm.out: glm.in EIG/xeigtsts
@echo GLM: Testing Generalized Linear Regression Model routines
- ./xeigtsts < glm.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sgqr.out: gqr.in xeigtsts
+sgqr.out: gqr.in EIG/xeigtsts
@echo GQR: Testing Generalized QR and RQ factorization routines
- ./xeigtsts < gqr.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-sgsv.out: gsv.in xeigtsts
+sgsv.out: gsv.in EIG/xeigtsts
@echo GSV: Testing Generalized Singular Value Decomposition routines
- ./xeigtsts < gsv.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-scsd.out: csd.in xeigtsts
+scsd.out: csd.in EIG/xeigtsts
@echo CSD: Testing CS Decomposition routines
- ./xeigtsts < csd.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
-slse.out: lse.in xeigtsts
+slse.out: lse.in EIG/xeigtsts
@echo LSE: Testing Constrained Linear Least Squares routines
- ./xeigtsts < lse.in > $@ 2>&1
+ ./EIG/xeigtsts < $< > $@ 2>&1
#
# ======== COMPLEX EIG TESTS ===========================
-cnep.out: nep.in xeigtstc
+cnep.out: nep.in EIG/xeigtstc
@echo NEP: Testing Nonsymmetric Eigenvalue Problem routines
- ./xeigtstc < nep.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-csep.out: sep.in xeigtstc
+csep.out: sep.in EIG/xeigtstc
@echo SEP: Testing Symmetric Eigenvalue Problem routines
- ./xeigtstc < sep.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cse2.out: se2.in xeigtstc
+cse2.out: se2.in EIG/xeigtstc
@echo SEP: Testing Symmetric Eigenvalue Problem routines
- ./xeigtstc < se2.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-csvd.out: svd.in xeigtstc
+csvd.out: svd.in EIG/xeigtstc
@echo SVD: Testing Singular Value Decomposition routines
- ./xeigtstc < svd.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cec.out: cec.in xeigtstc
+cec.out: cec.in EIG/xeigtstc
@echo CEC: Testing COMPLEX Eigen Condition Routines
- ./xeigtstc < cec.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-ced.out: ced.in xeigtstc
+ced.out: ced.in EIG/xeigtstc
@echo CES: Testing COMPLEX Nonsymmetric Schur Form Driver
- ./xeigtstc < ced.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cgg.out: cgg.in xeigtstc
+cgg.out: cgg.in EIG/xeigtstc
@echo CGG: Testing COMPLEX Nonsymmetric Generalized Eigenvalue Problem routines
- ./xeigtstc < cgg.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cgd.out: cgd.in xeigtstc
+cgd.out: cgd.in EIG/xeigtstc
@echo CGD: Testing COMPLEX Nonsymmetric Generalized Eigenvalue Problem driver routines
- ./xeigtstc < cgd.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-csb.out: csb.in xeigtstc
+csb.out: csb.in EIG/xeigtstc
@echo CHB: Testing Hermitian Eigenvalue Problem routines
- ./xeigtstc < csb.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-csg.out: csg.in xeigtstc
+csg.out: csg.in EIG/xeigtstc
@echo CSG: Testing Symmetric Generalized Eigenvalue Problem routines
- ./xeigtstc < csg.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cbal.out: cbal.in xeigtstc
+cbal.out: cbal.in EIG/xeigtstc
@echo CGEBAL: Testing the balancing of a COMPLEX general matrix
- ./xeigtstc < cbal.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cbak.out: cbak.in xeigtstc
+cbak.out: cbak.in EIG/xeigtstc
@echo CGEBAK: Testing the back transformation of a COMPLEX balanced matrix
- ./xeigtstc < cbak.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cgbal.out: cgbal.in xeigtstc
+cgbal.out: cgbal.in EIG/xeigtstc
@echo CGGBAL: Testing the balancing of a pair of COMPLEX general matrices
- ./xeigtstc < cgbal.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cgbak.out: cgbak.in xeigtstc
+cgbak.out: cgbak.in EIG/xeigtstc
@echo CGGBAK: Testing the back transformation of a pair of COMPLEX balanced matrices
- ./xeigtstc < cgbak.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cbb.out: cbb.in xeigtstc
+cbb.out: cbb.in EIG/xeigtstc
@echo CBB: Testing banded Singular Value Decomposition routines
- ./xeigtstc < cbb.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cglm.out: glm.in xeigtstc
+cglm.out: glm.in EIG/xeigtstc
@echo GLM: Testing Generalized Linear Regression Model routines
- ./xeigtstc < glm.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cgqr.out: gqr.in xeigtstc
+cgqr.out: gqr.in EIG/xeigtstc
@echo GQR: Testing Generalized QR and RQ factorization routines
- ./xeigtstc < gqr.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-cgsv.out: gsv.in xeigtstc
+cgsv.out: gsv.in EIG/xeigtstc
@echo GSV: Testing Generalized Singular Value Decomposition routines
- ./xeigtstc < gsv.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-ccsd.out: csd.in xeigtstc
+ccsd.out: csd.in EIG/xeigtstc
@echo CSD: Testing CS Decomposition routines
- ./xeigtstc < csd.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
-clse.out: lse.in xeigtstc
+clse.out: lse.in EIG/xeigtstc
@echo LSE: Testing Constrained Linear Least Squares routines
- ./xeigtstc < lse.in > $@ 2>&1
+ ./EIG/xeigtstc < $< > $@ 2>&1
#
# ======== DOUBLE EIG TESTS ===========================
-dnep.out: nep.in xeigtstd
+dnep.out: nep.in EIG/xeigtstd
@echo NEP: Testing Nonsymmetric Eigenvalue Problem routines
- ./xeigtstd < nep.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dsep.out: sep.in xeigtstd
+dsep.out: sep.in EIG/xeigtstd
@echo SEP: Testing Symmetric Eigenvalue Problem routines
- ./xeigtstd < sep.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dse2.out: se2.in xeigtstd
+dse2.out: se2.in EIG/xeigtstd
@echo SEP: Testing Symmetric Eigenvalue Problem routines
- ./xeigtstd < se2.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dsvd.out: svd.in xeigtstd
+dsvd.out: svd.in EIG/xeigtstd
@echo SVD: Testing Singular Value Decomposition routines
- ./xeigtstd < svd.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dec.out: dec.in xeigtstd
+dec.out: dec.in EIG/xeigtstd
@echo DEC: Testing DOUBLE PRECISION Eigen Condition Routines
- ./xeigtstd < dec.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-ded.out: ded.in xeigtstd
+ded.out: ded.in EIG/xeigtstd
@echo DEV: Testing DOUBLE PRECISION Nonsymmetric Eigenvalue Driver
- ./xeigtstd < ded.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dgg.out: dgg.in xeigtstd
+dgg.out: dgg.in EIG/xeigtstd
@echo DGG: Testing DOUBLE PRECISION Nonsymmetric Generalized Eigenvalue Problem routines
- ./xeigtstd < dgg.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dgd.out: dgd.in xeigtstd
+dgd.out: dgd.in EIG/xeigtstd
@echo DGD: Testing DOUBLE PRECISION Nonsymmetric Generalized Eigenvalue Problem driver routines
- ./xeigtstd < dgd.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dsb.out: dsb.in xeigtstd
+dsb.out: dsb.in EIG/xeigtstd
@echo DSB: Testing DOUBLE PRECISION Symmetric Eigenvalue Problem routines
- ./xeigtstd < dsb.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dsg.out: dsg.in xeigtstd
+dsg.out: dsg.in EIG/xeigtstd
@echo DSG: Testing DOUBLE PRECISION Symmetric Generalized Eigenvalue Problem routines
- ./xeigtstd < dsg.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dbal.out: dbal.in xeigtstd
+dbal.out: dbal.in EIG/xeigtstd
@echo DGEBAL: Testing the balancing of a DOUBLE PRECISION general matrix
- ./xeigtstd < dbal.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dbak.out: dbak.in xeigtstd
+dbak.out: dbak.in EIG/xeigtstd
@echo DGEBAK: Testing the back transformation of a DOUBLE PRECISION balanced matrix
- ./xeigtstd < dbak.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dgbal.out: dgbal.in xeigtstd
+dgbal.out: dgbal.in EIG/xeigtstd
@echo DGGBAL: Testing the balancing of a pair of DOUBLE PRECISION general matrices
- ./xeigtstd < dgbal.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dgbak.out: dgbak.in xeigtstd
+dgbak.out: dgbak.in EIG/xeigtstd
@echo DGGBAK: Testing the back transformation of a pair of DOUBLE PRECISION balanced matrices
- ./xeigtstd < dgbak.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dbb.out: dbb.in xeigtstd
+dbb.out: dbb.in EIG/xeigtstd
@echo DBB: Testing banded Singular Value Decomposition routines
- ./xeigtstd < dbb.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dglm.out: glm.in xeigtstd
+dglm.out: glm.in EIG/xeigtstd
@echo GLM: Testing Generalized Linear Regression Model routines
- ./xeigtstd < glm.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dgqr.out: gqr.in xeigtstd
+dgqr.out: gqr.in EIG/xeigtstd
@echo GQR: Testing Generalized QR and RQ factorization routines
- ./xeigtstd < gqr.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dgsv.out: gsv.in xeigtstd
+dgsv.out: gsv.in EIG/xeigtstd
@echo GSV: Testing Generalized Singular Value Decomposition routines
- ./xeigtstd < gsv.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dcsd.out: csd.in xeigtstd
+dcsd.out: csd.in EIG/xeigtstd
@echo CSD: Testing CS Decomposition routines
- ./xeigtstd < csd.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
-dlse.out: lse.in xeigtstd
+dlse.out: lse.in EIG/xeigtstd
@echo LSE: Testing Constrained Linear Least Squares routines
- ./xeigtstd < lse.in > $@ 2>&1
+ ./EIG/xeigtstd < $< > $@ 2>&1
#
# ======== COMPLEX16 EIG TESTS ===========================
-znep.out: nep.in xeigtstz
+znep.out: nep.in EIG/xeigtstz
@echo NEP: Testing Nonsymmetric Eigenvalue Problem routines
- ./xeigtstz < nep.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zsep.out: sep.in xeigtstz
+zsep.out: sep.in EIG/xeigtstz
@echo SEP: Testing Symmetric Eigenvalue Problem routines
- ./xeigtstz < sep.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zse2.out: se2.in xeigtstz
+zse2.out: se2.in EIG/xeigtstz
@echo SEP: Testing Symmetric Eigenvalue Problem routines
- ./xeigtstz < se2.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zsvd.out: svd.in xeigtstz
+zsvd.out: svd.in EIG/xeigtstz
@echo SVD: Testing Singular Value Decomposition routines
- ./xeigtstz < svd.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zec.out: zec.in xeigtstz
+zec.out: zec.in EIG/xeigtstz
@echo ZEC: Testing COMPLEX16 Eigen Condition Routines
- ./xeigtstz < zec.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zed.out: zed.in xeigtstz
+zed.out: zed.in EIG/xeigtstz
@echo ZES: Testing COMPLEX16 Nonsymmetric Schur Form Driver
- ./xeigtstz < zed.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zgg.out: zgg.in xeigtstz
+zgg.out: zgg.in EIG/xeigtstz
@echo ZGG: Testing COMPLEX16 Nonsymmetric Generalized Eigenvalue Problem routines
- ./xeigtstz < zgg.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zgd.out: zgd.in xeigtstz
+zgd.out: zgd.in EIG/xeigtstz
@echo ZGD: Testing COMPLEX16 Nonsymmetric Generalized Eigenvalue Problem driver routines
- ./xeigtstz < zgd.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zsb.out: zsb.in xeigtstz
+zsb.out: zsb.in EIG/xeigtstz
@echo ZHB: Testing Hermitian Eigenvalue Problem routines
- ./xeigtstz < zsb.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zsg.out: zsg.in xeigtstz
+zsg.out: zsg.in EIG/xeigtstz
@echo ZSG: Testing Symmetric Generalized Eigenvalue Problem routines
- ./xeigtstz < zsg.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zbal.out: zbal.in xeigtstz
+zbal.out: zbal.in EIG/xeigtstz
@echo ZGEBAL: Testing the balancing of a COMPLEX16 general matrix
- ./xeigtstz < zbal.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zbak.out: zbak.in xeigtstz
+zbak.out: zbak.in EIG/xeigtstz
@echo ZGEBAK: Testing the back transformation of a COMPLEX16 balanced matrix
- ./xeigtstz < zbak.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zgbal.out: zgbal.in xeigtstz
+zgbal.out: zgbal.in EIG/xeigtstz
@echo ZGGBAL: Testing the balancing of a pair of COMPLEX general matrices
- ./xeigtstz < zgbal.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zgbak.out: zgbak.in xeigtstz
+zgbak.out: zgbak.in EIG/xeigtstz
@echo ZGGBAK: Testing the back transformation of a pair of COMPLEX16 balanced matrices
- ./xeigtstz < zgbak.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zbb.out: zbb.in xeigtstz
+zbb.out: zbb.in EIG/xeigtstz
@echo ZBB: Testing banded Singular Value Decomposition routines
- ./xeigtstz < zbb.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zglm.out: glm.in xeigtstz
+zglm.out: glm.in EIG/xeigtstz
@echo GLM: Testing Generalized Linear Regression Model routines
- ./xeigtstz < glm.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zgqr.out: gqr.in xeigtstz
+zgqr.out: gqr.in EIG/xeigtstz
@echo GQR: Testing Generalized QR and RQ factorization routines
- ./xeigtstz < gqr.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zgsv.out: gsv.in xeigtstz
+zgsv.out: gsv.in EIG/xeigtstz
@echo GSV: Testing Generalized Singular Value Decomposition routines
- ./xeigtstz < gsv.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zcsd.out: csd.in xeigtstz
+zcsd.out: csd.in EIG/xeigtstz
@echo CSD: Testing CS Decomposition routines
- ./xeigtstz < csd.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
-zlse.out: lse.in xeigtstz
+zlse.out: lse.in EIG/xeigtstz
@echo LSE: Testing Constrained Linear Least Squares routines
- ./xeigtstz < lse.in > $@ 2>&1
+ ./EIG/xeigtstz < $< > $@ 2>&1
# ==============================================================================
-xlintsts: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) single
+LIN/xlintsts: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintsts
-xlintstc: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) complex
+LIN/xlintstc: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintstc
-xlintstd: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) double
+LIN/xlintstd: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintstd
-xlintstz: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) complex16
+LIN/xlintstz: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintstz
-xlintstrfs: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) proto-single
+LIN/xlintstrfs: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintstrfs
-xlintstrfc: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) proto-complex
+LIN/xlintstrfc: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintstrfc
-xlintstrfd: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) proto-double
+LIN/xlintstrfd: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintstrfd
-xlintstrfz: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) proto-complex16
+LIN/xlintstrfz: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintstrfz
-xlintstds: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) proto-double
+LIN/xlintstds: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintstds
-xlintstzc: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCLIN) $(FRC)
- cd LIN ; $(MAKE) proto-complex16
+LIN/xlintstzc: $(FRCLIN) $(FRC)
+ $(MAKE) -C LIN xlintstzc
-xeigtsts: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
- cd EIG ; $(MAKE) single
+EIG/xeigtsts: $(FRCEIG) $(FRC)
+ $(MAKE) -C EIG xeigtsts
-xeigtstc: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
- cd EIG ; $(MAKE) complex
+EIG/xeigtstc: $(FRCEIG) $(FRC)
+ $(MAKE) -C EIG xeigtstc
-xeigtstd: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
- cd EIG ; $(MAKE) double
+EIG/xeigtstd: $(FRCEIG) $(FRC)
+ $(MAKE) -C EIG xeigtstd
-xeigtstz: ../$(LAPACKLIB) ../$(TMGLIB) $(FRCEIG) $(FRC)
- cd EIG ; $(MAKE) complex16
+EIG/xeigtstz: $(FRCEIG) $(FRC)
+ $(MAKE) -C EIG xeigtstz
-clean:
+clean: cleantest
+cleantest:
rm -f *.out core
-cleanup:
- rm -f x* *.out core
-
FRCLIN:
@FRCLIN=$(FRCLIN)
CHR 10 List types on next line if 0 < NTYPES < 10
CHK 10 List types on next line if 0 < NTYPES < 10
CHA 10 List types on next line if 0 < NTYPES < 10
+CH2 10 List types on next line if 0 < NTYPES < 10
+CSA 11 List types on next line if 0 < NTYPES < 10
+CS2 11 List types on next line if 0 < NTYPES < 10
CHP 10 List types on next line if 0 < NTYPES < 10
CSY 11 List types on next line if 0 < NTYPES < 11
CSR 11 List types on next line if 0 < NTYPES < 11
0.0000D+00 0.8192D+04 0.0000D+00 0.0000D+00 0.8000D+01
1 5
- 1.0000D+00 0.0000D-03 0.0000D-03 0.0000D-03 250.0000D-03
+ 1.0000D+00 0.0000D-03 0.0000D-03 0.0000D-03 2.0000D+00
0.0000D-03 2.0000D+00 1.0240D+03 16.0000D+00 16.0000D+00
- 256.0000D-03 1.0000D-03 4.0000D+00 0.0000D-03 2.0480D+03
+ 3.2000D-02 1.0000D-03 4.0000D+00 0.0000D-03 2.0480D+03
0.0000D-03 250.0000D-03 16.0000D+00 4.0000D+00 4.0000D+00
0.0000D-03 2.0480D+03 0.0000D-03 0.0000D-03 8.0000D+00
- 64.0000D+00 500.0000D-03 62.5000D-03 4.0000D+00 2.0000D+00
+ 8.0000D+00 500.0000D-03 62.5000D-03 4.0000D+00 2.0000D+00
4
0.1000D+01 0.1000D+07 0.1000D+07 0.1000D+07
0.0000D+00 0.8000D+01 0.0000D+00 0.4000D-02 0.1250D+00 -0.2000D+00 0.3000D+01
2 5
- 6.4000D+01 2.5000D-01 5.00000D-01 0.0000D+00 0.0000D+00 1.0000D+00 -2.0000D+00
- 0.0000D+00 4.0000D+00 2.00000D+00 4.0960D+00 1.6000D+00 0.0000D+00 1.0240D+01
- 0.0000D+00 5.0000D-01 3.00000D+00 4.0960D+00 1.0000D+00 0.0000D+00 -6.4000D+00
- 0.0000D+00 1.0000D+00 -3.90625D+00 1.0000D+00 -3.1250D+00 0.0000D+00 8.0000D+00
- 0.0000D+00 -2.0000D+00 4.00000D+00 1.6000D+00 2.0000D+00 -8.0000D+00 8.0000D+00
+ 6.4000D+01 1.0000D+00 5.00000D-01 0.0000D+00 0.0000D+00 1.0000D+00 -2.0000D+00
+ 0.0000D+00 4.0000D+00 5.00000D-01 1.0240D+00 8.0000D-01 0.0000D+00 2.5600D+00
+ 0.0000D+00 2.0000D+00 3.00000D+00 4.0960D+00 2.0000D+00 0.0000D+00 -6.4000D+00
+ 0.0000D+00 4.0000D+00 -3.90625D+00 1.0000D+00 -6.2500D+00 0.0000D+00 8.0000D+00
+ 0.0000D+00 -4.0000D+00 2.00000D+00 8.0000D-01 2.0000D+00 -4.0000D+00 4.0000D+00
0.0000D+00 0.0000D+00 0.00000D+00 0.0000D+00 0.0000D+00 6.0000D+00 1.0000D+00
0.0000D+00 0.0000D+00 0.00000D+00 0.0000D+00 0.0000D+00 0.0000D+00 0.0000D+00
- 3.0000D+00 1.953125D-03 3.1250D-02 3.2000D+01 2.5000D-01 1.0000D+00 6.0000D+00
+ 3.0000D+00 7.812500D-03 3.1250D-02 3.2000D+01 5.0000D-01 1.0000D+00 6.0000D+00
5
0.1000D+04 0.2000D+01 0.3000D+01 0.4000D+01 0.5000D+06
0.6000D+01 0.2000D+03 0.1000D+01 0.6000D+03 0.3000D+01
1 5
- 1.0000D+03 3.1250D-02 3.7500D-01 6.2500D-02 3.90625D+03
- 5.7600D+02 0.0000D+00 1.6000D-03 1.0000D+00 1.5000D+00
- 0.0000D+00 -3.7500D+01 2.0000D+00 1.2500D-01 6.2500D-02
- 5.7600D+02 2.0000D-03 8.0000D+00 1.0000D+00 -5.0000D+02
- 7.6800D+02 4.0000D+02 1.6000D+01 1.2000D+03 3.0000D+00
+ 1.0000D+03 3.1250D-02 3.7500D-01 3.1250D-02 1.95312500D+03
+ 5.7600D+02 0.0000D+00 1.6000D-03 5.0000D-01 7.50000000D-01
+ 0.0000D+00 -3.7500D+01 2.0000D+00 6.2500D-02 3.12500000D-02
+ 1.1520D+03 4.0000D-03 1.6000D+01 1.0000D+00 -5.00000000D+02
+ 1.5360D+03 8.0000D+02 3.2000D+01 1.2000D+03 3.00000000D+00
- 1.2800D+02 2.0000D+00 1.6000D+01 2.0000D+00 1.0000D+00
+ 3.2000D+01 5.0000D-01 4.0000D+00 2.5000D-01 1.2500D-01
6
1.0000D+00 1.0000D+120 0.0000D+00 0.0000D+00 0.0000D+00 0.0000D+00
0.0000D+00 0.0000D+00 0.0000D+00 0.0000D+00 1.0000D-120 1.0000D+00
1 6
- 1.000000000000000000D+00 6.344854593289122931D+03 0.000000000000000000D+00 0.000000000000000000D+00 0.000000000000000000D+00 0.000000000000000000D+00
- 1.576080247855779135D-04 1.000000000000000000D+00 6.344854593289122931D+03 0.000000000000000000D+00 0.000000000000000000D+00 0.000000000000000000D+00
- 0.000000000000000000D+00 1.576080247855779135D-04 1.000000000000000000D+00 3.172427296644561466D+03 0.000000000000000000D+00 0.000000000000000000D+00
- 0.000000000000000000D+00 0.000000000000000000D+00 3.152160495711558270D-04 1.000000000000000000D+00 1.586213648322280733D+03 0.000000000000000000D+00
- 0.000000000000000000D+00 0.000000000000000000D+00 0.000000000000000000D+00 6.304320991423116539D-04 1.000000000000000000D+00 1.586213648322280733D+03
- 0.000000000000000000D+00 0.000000000000000000D+00 0.000000000000000000D+00 0.000000000000000000D+00 6.304320991423116539D-04 1.000000000000000000D+00
-
- 2.494800386918399765D+291 1.582914569427869018D+175 1.004336277661868922D+59 3.186183822264904554D-58 5.053968264940243633D-175 8.016673440035891112D-292
-
+0.10000000000000000000D+01 0.63448545932891229313D+04 0.00000000000000000000D+00 0.00000000000000000000D+00 0.00000000000000000000D+00 0.00000000000000000000D+00
+0.15760802478557791348D-03 0.10000000000000000000D+01 0.63448545932891229313D+04 0.00000000000000000000D+00 0.00000000000000000000D+00 0.00000000000000000000D+00
+0.00000000000000000000D+00 0.15760802478557791348D-03 0.10000000000000000000D+01 0.31724272966445614657D+04 0.00000000000000000000D+00 0.00000000000000000000D+00
+0.00000000000000000000D+00 0.00000000000000000000D+00 0.31521604957115582695D-03 0.10000000000000000000D+01 0.15862136483222807328D+04 0.00000000000000000000D+00
+0.00000000000000000000D+00 0.00000000000000000000D+00 0.00000000000000000000D+00 0.63043209914231165391D-03 0.10000000000000000000D+01 0.79310682416114036641D+03
+0.00000000000000000000D+00 0.00000000000000000000D+00 0.00000000000000000000D+00 0.00000000000000000000D+00 0.12608641982846233078D-02 0.10000000000000000000D+01
+
+ 2.494800386918399765D+291 1.582914569427869018D+175 1.004336277661868922D+59 3.186183822264904554D-58 5.053968264940243633D-175 0.40083367200179455560D-291;
0
DSR 10 List types on next line if 0 < NTYPES < 10
DSK 10 List types on next line if 0 < NTYPES < 10
DSA 10 List types on next line if 0 < NTYPES < 10
+DS2 10 List types on next line if 0 < NTYPES < 10
DSP 10 List types on next line if 0 < NTYPES < 10
DTR 18 List types on next line if 0 < NTYPES < 18
DTP 18 List types on next line if 0 < NTYPES < 18
SSR 10 List types on next line if 0 < NTYPES < 10
SSK 10 List types on next line if 0 < NTYPES < 10
SSA 10 List types on next line if 0 < NTYPES < 10
+SS2 10 List types on next line if 0 < NTYPES < 10
SSP 10 List types on next line if 0 < NTYPES < 10
STR 18 List types on next line if 0 < NTYPES < 18
STP 18 List types on next line if 0 < NTYPES < 18
ZHR 10 List types on next line if 0 < NTYPES < 10
ZHK 10 List types on next line if 0 < NTYPES < 10
ZHA 10 List types on next line if 0 < NTYPES < 10
+ZH2 10 List types on next line if 0 < NTYPES < 10
+ZSA 11 List types on next line if 0 < NTYPES < 10
+ZS2 11 List types on next line if 0 < NTYPES < 10
ZHP 10 List types on next line if 0 < NTYPES < 10
ZSY 11 List types on next line if 0 < NTYPES < 11
ZSR 11 List types on next line if 0 < NTYPES < 11
--- /dev/null
+# Windows testing.
+# Syntax for this file:
+# http://www.appveyor.com/docs/appveyor-yml
+
+shallow_clone: true
+
+platform: x64
+
+cache:
+ - x86_64-4.9.2-release-win32-seh-rt_v4-rev4.7z
+ - i686-4.9.2-release-win32-dwarf-rt_v4-rev4.7z
+
+environment:
+ CTEST_OUTPUT_ON_FAILURE: 1
+ matrix:
+ - MINGW_DIR: mingw64
+ MINGW_URL: https://sourceforge.net/projects/mingw-w64/files/Toolchains%20targetting%20Win64/Personal%20Builds/mingw-builds/4.9.2/threads-win32/seh/x86_64-4.9.2-release-win32-seh-rt_v4-rev4.7z/download
+ MINGW_ARCHIVE: x86_64-4.9.2-release-win32-seh-rt_v4-rev4.7z
+ - MINGW_DIR: mingw32
+ MINGW_URL: https://sourceforge.net/projects/mingw-w64/files/Toolchains%20targetting%20Win32/Personal%20Builds/mingw-builds/4.9.2/threads-win32/dwarf/i686-4.9.2-release-win32-dwarf-rt_v4-rev4.7z/download
+ MINGW_ARCHIVE: i686-4.9.2-release-win32-dwarf-rt_v4-rev4.7z
+
+install:
+ - if not exist "%MINGW_ARCHIVE%" appveyor DownloadFile "%MINGW_URL%" -FileName "%MINGW_ARCHIVE%"
+ - 7z x -y "%MINGW_ARCHIVE%" > nul
+ # CMake refuses to generate MinGW Makefiles if sh.exe is in the Path
+ - ps: Get-Command sh.exe -All | Remove-Item
+
+build_script:
+ - echo "NUMBER_OF_PROCESSORS=%NUMBER_OF_PROCESSORS%"
+ - set PATH=%CD%\%MINGW_DIR%\bin;%PATH%
+ - g++ --version
+ - mingw32-make --version
+ - cmake --version
+ - if "%APPVEYOR_REPO_TAG%"=="true" (set CMAKE_BUILD_TYPE=Release) else (set CMAKE_BUILD_TYPE=Debug)
+ - set SRC_DIR=%CD%
+ - echo %SRC_DIR%
+ - set BLD_DIR=%SRC_DIR%\..\lapack-appveyor-bld
+ - set INST_DIR=%SRC_DIR%\..\lapack-appveyor-install
+ - mkdir -p %BLD_DIR%
+ - cd %BLD_DIR%
+ # See issue #17 on github dashboard. Once resolved, use -DCBLAS=ON
+ # - cmake -DCMAKE_INSTALL_PREFIX=${INST_DIR} -DLAPACKE=ON ${SRC_DIR}
+ - cmake
+ -G "MinGW Makefiles"
+ -DBUILDNAME:STRING="appveyor-%MINGW_DIR%-%APPVEYOR_REPO_BRANCH%"
+ -DCMAKE_BUILD_TYPE=%CMAKE_BUILD_TYPE%
+ -DCMAKE_INSTALL_PREFIX=%INST_DIR%
+ -DCBLAS:BOOL=ON
+ -DLAPACKE:BOOL=ON
+ -DBUILD_TESTING=ON
+ -DLAPACKE_WITH_TMG:BOOL=ON
+ %SRC_DIR%
+ - mingw32-make -j%NUMBER_OF_PROCESSORS%
+
+test_script:
+ - ctest -D ExperimentalStart
+ - ctest -D ExperimentalConfigure
+ - ctest -D ExperimentalBuild -j%NUMBER_OF_PROCESSORS%
+ - ctest -D ExperimentalTest --schedule-random -j%NUMBER_OF_PROCESSORS% --output-on-failure --timeout 100 -E "CBLAS\-.*cblat1"
+ - ctest -D ExperimentalSubmit
+
+after_test:
+ - mingw32-make install -j%NUMBER_OF_PROCESSORS%
-prefix=@prefix@
-libdir=@libdir@
+libdir=@CMAKE_INSTALL_FULL_LIBDIR@
+includedir=@CMAKE_INSTALL_FULL_INCLUDEDIR@
Name: LAPACK
Description: FORTRAN reference implementation of LAPACK Linear Algebra PACKage
Version: @LAPACK_VERSION@
URL: http://www.netlib.org/lapack/
Libs: -L${libdir} -llapack
-Requires: blas
+Requires.private: blas
letter+"bb","glm","gqr",
"gsv","csd","lse",
letter+"test", letter+dtypes[0][dtype-1]+"test",letter+"test_rfp"),
- ("Nonsymmetric Eigenvalue Problem", "Symmetric Eigenvalue Problem", "Symmetric Eigenvalue Problem 2 stage", "Singular Value Decomposition",
- "Eigen Condition","Nonsymmetric Eigenvalue","Nonsymmetric Generalized Eigenvalue Problem",
- "Nonsymmetric Generalized Eigenvalue Problem driver", "Symmetric Eigenvalue Problem", "Symmetric Eigenvalue Generalized Problem",
- "Banded Singular Value Decomposition routines", "Generalized Linear Regression Model routines", "Generalized QR and RQ factorization routines",
- "Generalized Singular Value Decomposition routines", "CS Decomposition routines", "Constrained Linear Least Squares routines",
- "Linear Equation routines", "Mixed Precision linear equation routines","RFP linear equation routines"),
+ ("Nonsymmetric-Eigenvalue-Problem", "Symmetric-Eigenvalue-Problem", "Symmetric-Eigenvalue-Problem-2-stage", "Singular-Value-Decomposition",
+ "Eigen-Condition","Nonsymmetric-Eigenvalue","Nonsymmetric-Generalized-Eigenvalue-Problem",
+ "Nonsymmetric-Generalized-Eigenvalue-Problem-driver", "Symmetric-Eigenvalue-Problem", "Symmetric-Eigenvalue-Generalized-Problem",
+ "Banded-Singular-Value-Decomposition-routines", "Generalized-Linear-Regression-Model-routines", "Generalized-QR-and-RQ-factorization-routines",
+ "Generalized-Singular-Value-Decomposition-routines", "CS-Decomposition-routines", "Constrained-Linear-Least-Squares-routines",
+ "Linear-Equation-routines", "Mixed-Precision-linear-equation-routines","RFP-linear-equation-routines"),
(letter+"nep", letter+"sep", letter+"se2", letter+"svd",
letter+"ec",letter+"ed",letter+"gg",
letter+"gd",letter+"sb",letter+"sg",
# EIG TESTS
cmdbase="xeigtst"+letter+" < "+dtests[0][dtest]+".in > "+dtests[2][dtest]+".out"
if (not just_errors and not short_summary):
- print("--> Testing "+name+" "+dtests[1][dtest]+" [ "+cmdbase+" ]")
+ print("Testing "+name+" "+dtests[1][dtest]+"-"+cmdbase, end=' ')
# Run the process: either to read the file or run the LAPACK testing
nb_test = run_summary_test(f, cmdbase, short_summary)
list_results[0][dtype]+=nb_test[0]
if (not short_summary):
if (nb_test[0]>0 and just_errors==0):
- print("--> Tests passed: "+str(nb_test[0]))
+ print("passed: "+str(nb_test[0]))
if (nb_test[1]>0):
- print("--> Tests failing to pass the threshold: "+str(nb_test[1]))
+ print("failing to pass the threshold: "+str(nb_test[1]))
if (nb_test[2]>0):
- print("--> Illegal Error: "+str(nb_test[2]))
+ print("Illegal Error: "+str(nb_test[2]))
if (nb_test[3]>0):
- print("--> Info Error: "+str(nb_test[3]))
+ print("Info Error: "+str(nb_test[3]))
if (got_error>0 and just_errors==1):
print("ERROR IS LOCATED IN "+name+" "+dtests[1][dtest]+" [ "+cmdbase+" ]")
print("")
####################################################################
# LAPACK make include file. #
-# LAPACK, Version 3.7.0 #
-# December 2016 #
+# LAPACK, Version 3.8.0 #
+# November 2017 #
####################################################################
-#
+
SHELL = /bin/sh
+
+# CC is the C compiler, normally invoked with options CFLAGS.
#
-# Modify the FORTRAN and OPTS definitions to refer to the
-# compiler and desired compiler options for your machine. NOOPT
-# refers to the compiler options desired when NO OPTIMIZATION is
-# selected. Define LOADER and LOADOPTS to refer to the loader and
-# desired load options for your machine.
+CC = gcc
+CFLAGS = -O3
+
+# Modify the FORTRAN and OPTS definitions to refer to the compiler
+# and desired compiler options for your machine. NOOPT refers to
+# the compiler options desired when NO OPTIMIZATION is selected.
#
# Note: During a regular execution, LAPACK might create NaN and Inf
# and handle these quantities appropriately. As a consequence, one
# should not compile LAPACK with flags such as -ffpe-trap=overflow.
#
-FORTRAN = gfortran
-OPTS = -O2 -frecursive
-DRVOPTS = $(OPTS)
-NOOPT = -O0 -frecursive
+FORTRAN = gfortran
+OPTS = -O2 -frecursive
+DRVOPTS = $(OPTS)
+NOOPT = -O0 -frecursive
+
+# Define LOADER and LOADOPTS to refer to the loader and desired
+# load options for your machine.
+#
LOADER = gfortran
LOADOPTS =
-#
-# Comment out the following line to include deprecated routines to the
-# LAPACK library.
+
+# The archiver and the flag(s) to use when building an archive
+# (library). If your system has no ranlib, set RANLIB = echo.
+#
+ARCH = ar
+ARCHFLAGS = cr
+RANLIB = ranlib
+
+# Timer for the SECOND and DSECND routines
+#
+# Default: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME
+#TIMER = EXT_ETIME
+# For RS6K: SECOND and DSECND will use a call to the
+# EXTERNAL FUNCTION ETIME_
+#TIMER = EXT_ETIME_
+# For gfortran compiler: SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION ETIME
+TIMER = INT_ETIME
+# If your Fortran compiler does not provide etime (like Nag Fortran
+# Compiler, etc...) SECOND and DSECND will use a call to the
+# INTERNAL FUNCTION CPU_TIME
+#TIMER = INT_CPU_TIME
+# If none of these work, you can use the NONE value.
+# In that case, SECOND and DSECND will always return 0.
+#TIMER = NONE
+
+# Uncomment the following line to include deprecated routines in
+# the LAPACK library.
#
#BUILD_DEPRECATED = Yes
+
+# LAPACKE has the interface to some routines from tmglib.
+# If LAPACKE_WITH_TMG is defined, add those routines to LAPACKE.
#
-# Timer for the SECOND and DSECND routines
-#
-# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME
-# TIMER = EXT_ETIME
-# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_
-# TIMER = EXT_ETIME_
-# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME
-TIMER = INT_ETIME
-# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...)
-# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME
-# TIMER = INT_CPU_TIME
-# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0
-# TIMER = NONE
-#
-# Configuration LAPACKE: Native C interface to LAPACK
-# To generate LAPACKE library: type 'make lapackelib'
-# Configuration file: turned off (default)
-# Complex types: C99 (default)
-# Name pattern: mixed case (default)
-# (64-bit) Data model: LP64 (default)
-#
-# CC is the C compiler, normally invoked with options CFLAGS.
-#
-CC = gcc
-CFLAGS = -O3
-#
-# The archiver and the flag(s) to use when building archive (library)
-# If you system has no ranlib, set RANLIB = echo.
-#
-ARCH = ar
-ARCHFLAGS= cr
-RANLIB = ranlib
-#
+#LAPACKE_WITH_TMG = Yes
+
# Location of the extended-precision BLAS (XBLAS) Fortran library
# used for building and testing extended-precision routines. The
-# relevant routines will be compiled and XBLAS will be linked only if
-# USEXBLAS is defined.
-#
-# USEXBLAS = Yes
-XBLASLIB =
-# XBLASLIB = -lxblas
+# relevant routines will be compiled and XBLAS will be linked only
+# if USEXBLAS is defined.
#
+#USEXBLAS = Yes
+#XBLASLIB = -lxblas
+
# The location of the libraries to which you will link. (The
# machine-specific, optimized BLAS library should be used whenever
# possible.)
projects / platform / upstream / openblas.git / commitdiff