Update Eigen to the latest stable release, 3.2.2
./Eigen/src/Core/util/NonMPL2.h is left untouched, so that
usage of non MPL2 code is disabled.
Change-Id: I86fc9257b3c30d0ca15b268d4ef07bf038bba7ca
diff --git a/lapack/CMakeLists.txt b/lapack/CMakeLists.txt
index 062845a..9883d4c 100644
--- a/lapack/CMakeLists.txt
+++ b/lapack/CMakeLists.txt
@@ -7,6 +7,9 @@
if(EIGEN_Fortran_COMPILER_WORKS)
enable_language(Fortran OPTIONAL)
+ if(NOT CMAKE_Fortran_COMPILER)
+ set(EIGEN_Fortran_COMPILER_WORKS OFF)
+ endif()
endif()
add_custom_target(lapack)
@@ -18,346 +21,80 @@
if(EIGEN_Fortran_COMPILER_WORKS)
-get_filename_component(eigen_full_path_to_reference_to_reference_lapack "./reference/" ABSOLUTE)
-if(EXISTS ${eigen_full_path_to_reference_to_reference_lapack})
-set(EigenLapack_SRCS ${EigenLapack_SRCS}
-# reference/dpotrf.f reference/zpotrf.f reference/cpotrf.f reference/spotrf.f
-# reference/dpotrs.f reference/spotrs.f reference/zpotrs.f reference/cpotrs.f
-# reference/dgetrf.f reference/cgetrf.f reference/sgetrf.f reference/zgetrf.f
-# reference/cgetrs.f reference/dgetrs.f reference/sgetrs.f reference/zgetrs.f
-# reference/dsyev.f reference/ssyev.f
-
-reference/dlamch.f reference/ilaver.f reference/lsame.f reference/slamch.f reference/second_NONE.f reference/dsecnd_NONE.f
-reference/cbdsqr.f reference/ctbrfs.f reference/dorml2.f reference/sla_porfsx_extended.f reference/zggglm.f
-reference/cgbbrd.f reference/ctbtrs.f reference/dormlq.f reference/sla_porpvgrw.f reference/zgghrd.f
-reference/cgbcon.f reference/ctfsm.f reference/dormql.f reference/slapy2.f reference/zgglse.f
-reference/cgbequb.f reference/ctftri.f reference/dormqr.f reference/slapy3.f reference/zggqrf.f
-reference/cgbequ.f reference/ctfttp.f reference/dormr2.f reference/slaqgb.f reference/zggrqf.f
-reference/cgbrfs.f reference/ctfttr.f reference/dormr3.f reference/slaqge.f reference/zggsvd.f
-reference/cgbrfsx.f reference/ctgevc.f reference/dormrq.f reference/slaqp2.f reference/zggsvp.f
-reference/cgbsv.f reference/ctgex2.f reference/dormrz.f reference/slaqps.f reference/zgtcon.f
-reference/cgbsvx.f reference/ctgexc.f reference/dormtr.f reference/slaqr0.f reference/zgtrfs.f
-reference/cgbsvxx.f reference/ctgsen.f reference/dpbcon.f reference/slaqr1.f reference/zgtsv.f
-reference/cgbtf2.f reference/ctgsja.f reference/dpbequ.f reference/slaqr2.f reference/zgtsvx.f
-reference/cgbtrf.f reference/ctgsna.f reference/dpbrfs.f reference/slaqr3.f reference/zgttrf.f
-reference/cgbtrs.f reference/ctgsy2.f reference/dpbstf.f reference/slaqr4.f reference/zgttrs.f
-reference/cgebak.f reference/ctgsyl.f reference/dpbsv.f reference/slaqr5.f reference/zgtts2.f
-reference/cgebal.f reference/ctpcon.f reference/dpbsvx.f reference/slaqsb.f reference/zhbevd.f
-reference/cgebd2.f reference/ctprfs.f reference/dpbtf2.f reference/slaqsp.f reference/zhbev.f
-reference/cgebrd.f reference/ctptri.f reference/dpbtrf.f reference/slaqsy.f reference/zhbevx.f
-reference/cgecon.f reference/ctptrs.f reference/dpbtrs.f reference/slaqtr.f reference/zhbgst.f
-reference/cgeequb.f reference/ctpttf.f reference/dpftrf.f reference/slar1v.f reference/zhbgvd.f
-reference/cgeequ.f reference/ctpttr.f reference/dpftri.f reference/slar2v.f reference/zhbgv.f
-reference/cgees.f reference/ctrcon.f reference/dpftrs.f reference/slarfb.f reference/zhbgvx.f
-reference/cgeesx.f reference/ctrevc.f reference/dpocon.f reference/slarf.f reference/zhbtrd.f
-reference/cgeev.f reference/ctrexc.f reference/dpoequb.f reference/slarfg.f reference/zhecon.f
-reference/cgeevx.f reference/ctrrfs.f reference/dpoequ.f reference/slarfp.f reference/zheequb.f
-reference/cgegs.f reference/ctrsen.f reference/dporfs.f reference/slarft.f reference/zheevd.f
-reference/cgegv.f reference/ctrsna.f reference/dporfsx.f reference/slarfx.f reference/zheev.f
-reference/cgehd2.f reference/ctrsyl.f reference/dposv.f reference/slargv.f reference/zheevr.f
-reference/cgehrd.f reference/ctrti2.f reference/dposvx.f reference/slarnv.f reference/zheevx.f
-reference/cgelq2.f reference/ctrtri.f reference/dposvxx.f reference/sla_rpvgrw.f reference/zhegs2.f
-reference/cgelqf.f reference/ctrtrs.f reference/dpotf2.f reference/slarra.f reference/zhegst.f
-reference/cgelsd.f reference/ctrttf.f
-reference/slarrb.f reference/zhegvd.f
-reference/cgels.f reference/ctrttp.f reference/dpotri.f reference/slarrc.f reference/zhegv.f
-reference/cgelss.f reference/ctzrqf.f reference/slarrd.f reference/zhegvx.f
-reference/cgelsx.f reference/ctzrzf.f reference/dppcon.f reference/slarre.f reference/zherfs.f
-reference/cgelsy.f reference/cung2l.f reference/dppequ.f reference/slarrf.f reference/zherfsx.f
-reference/cgeql2.f reference/cung2r.f reference/dpprfs.f reference/slarrj.f reference/zhesv.f
-reference/cgeqlf.f reference/cungbr.f reference/dppsv.f reference/slarrk.f reference/zhesvx.f
-reference/cgeqp3.f reference/cunghr.f reference/dppsvx.f reference/slarrr.f reference/zhesvxx.f
-reference/cgeqpf.f reference/cungl2.f reference/dpptrf.f reference/slarrv.f reference/zhetd2.f
-reference/cgeqr2.f reference/cunglq.f reference/dpptri.f reference/slarscl2.f reference/zhetf2.f
-reference/cgeqrf.f reference/cungql.f reference/dpptrs.f reference/slartg.f reference/zhetrd.f
-reference/cgerfs.f reference/cungqr.f reference/dpstf2.f reference/slartv.f reference/zhetrf.f
-reference/cgerfsx.f reference/cungr2.f reference/dpstrf.f reference/slaruv.f reference/zhetri.f
-reference/cgerq2.f reference/cungrq.f reference/dptcon.f reference/slarzb.f reference/zhetrs.f
-reference/cgerqf.f reference/cungtr.f reference/dpteqr.f reference/slarz.f reference/zhfrk.f
-reference/cgesc2.f reference/cunm2l.f reference/dptrfs.f reference/slarzt.f reference/zhgeqz.f
-reference/cgesdd.f reference/cunm2r.f reference/dptsv.f reference/slas2.f reference/zhpcon.f
-reference/cgesvd.f reference/cunmbr.f reference/dptsvx.f reference/slascl2.f reference/zhpevd.f
-reference/cgesv.f reference/cunmhr.f reference/dpttrf.f reference/slascl.f reference/zhpev.f
-reference/cgesvx.f reference/cunml2.f reference/dpttrs.f reference/slasd0.f reference/zhpevx.f
-reference/cgesvxx.f reference/cunmlq.f reference/dptts2.f reference/slasd1.f reference/zhpgst.f
-reference/cgetc2.f reference/cunmql.f reference/drscl.f reference/slasd2.f reference/zhpgvd.f
-reference/cgetf2.f reference/cunmqr.f reference/dsbevd.f reference/slasd3.f reference/zhpgv.f
-reference/cunmr2.f reference/dsbev.f reference/slasd4.f reference/zhpgvx.f
-reference/cgetri.f reference/cunmr3.f reference/dsbevx.f reference/slasd5.f reference/zhprfs.f
- reference/cunmrq.f reference/dsbgst.f reference/slasd6.f reference/zhpsv.f
-reference/cggbak.f reference/cunmrz.f reference/dsbgvd.f reference/slasd7.f reference/zhpsvx.f
-reference/cggbal.f reference/cunmtr.f reference/dsbgv.f reference/slasd8.f reference/zhptrd.f
-reference/cgges.f reference/cupgtr.f reference/dsbgvx.f reference/slasda.f reference/zhptrf.f
-reference/cggesx.f reference/cupmtr.f reference/dsbtrd.f reference/slasdq.f reference/zhptri.f
-reference/cggev.f reference/dbdsdc.f reference/dsfrk.f reference/slasdt.f reference/zhptrs.f
-reference/cggevx.f reference/dbdsqr.f reference/dsgesv.f reference/slaset.f reference/zhsein.f
-reference/cggglm.f reference/ddisna.f reference/dspcon.f reference/slasq1.f reference/zhseqr.f
-reference/cgghrd.f reference/dgbbrd.f reference/dspevd.f reference/slasq2.f reference/zlabrd.f
-reference/cgglse.f reference/dgbcon.f reference/dspev.f reference/slasq3.f reference/zlacgv.f
-reference/cggqrf.f reference/dgbequb.f reference/dspevx.f reference/slasq4.f reference/zlacn2.f
-reference/cggrqf.f reference/dgbequ.f reference/dspgst.f reference/slasq5.f reference/zlacon.f
-reference/cggsvd.f reference/dgbrfs.f reference/dspgvd.f reference/slasq6.f reference/zlacp2.f
-reference/cggsvp.f reference/dgbrfsx.f reference/dspgv.f reference/slasr.f reference/zlacpy.f
-reference/cgtcon.f reference/dgbsv.f reference/dspgvx.f reference/slasrt.f reference/zlacrm.f
-reference/cgtrfs.f reference/dgbsvx.f reference/dsposv.f reference/slassq.f reference/zlacrt.f
-reference/cgtsv.f reference/dgbsvxx.f reference/dsprfs.f reference/slasv2.f reference/zladiv.f
-reference/cgtsvx.f reference/dgbtf2.f reference/dspsv.f reference/slaswp.f reference/zlaed0.f
-reference/cgttrf.f reference/dgbtrf.f reference/dspsvx.f reference/slasy2.f reference/zlaed7.f
-reference/cgttrs.f reference/dgbtrs.f reference/dsptrd.f reference/sla_syamv.f reference/zlaed8.f
-reference/cgtts2.f reference/dgebak.f reference/dsptrf.f reference/slasyf.f reference/zlaein.f
-reference/chbevd.f reference/dgebal.f reference/dsptri.f reference/sla_syrcond.f reference/zlaesy.f
-reference/chbev.f reference/dgebd2.f reference/dsptrs.f reference/sla_syrfsx_extended.f reference/zlaev2.f
-reference/chbevx.f reference/dgebrd.f reference/dstebz.f reference/sla_syrpvgrw.f reference/zlag2c.f
-reference/chbgst.f reference/dgecon.f reference/dstedc.f reference/slatbs.f reference/zla_gbamv.f
-reference/chbgvd.f reference/dgeequb.f reference/dstegr.f reference/slatdf.f reference/zla_gbrcond_c.f
-reference/chbgv.f reference/dgeequ.f reference/dstein.f reference/slatps.f reference/zla_gbrcond_x.f
-reference/chbgvx.f reference/dgees.f reference/dstemr.f reference/slatrd.f reference/zla_gbrfsx_extended.f
-reference/chbtrd.f reference/dgeesx.f reference/dsteqr.f reference/slatrs.f reference/zla_gbrpvgrw.f
-reference/checon.f reference/dgeev.f reference/dsterf.f reference/slatrz.f reference/zla_geamv.f
-reference/cheequb.f reference/dgeevx.f reference/dstevd.f reference/slatzm.f reference/zla_gercond_c.f
-reference/cheevd.f reference/dgegs.f reference/dstev.f reference/slauu2.f reference/zla_gercond_x.f
-reference/cheev.f reference/dgegv.f reference/dstevr.f reference/slauum.f reference/zla_gerfsx_extended.f
-reference/cheevr.f reference/dgehd2.f reference/dstevx.f reference/sla_wwaddw.f reference/zlags2.f
-reference/cheevx.f reference/dgehrd.f reference/dsycon.f reference/sopgtr.f reference/zlagtm.f
-reference/chegs2.f reference/dgejsv.f reference/dsyequb.f reference/sopmtr.f reference/zla_heamv.f
-reference/chegst.f reference/dgelq2.f reference/dsyevd.f reference/sorg2l.f reference/zlahef.f
-reference/chegvd.f reference/dgelqf.f reference/sorg2r.f reference/zla_hercond_c.f
-reference/chegv.f reference/dgelsd.f reference/dsyevr.f reference/sorgbr.f reference/zla_hercond_x.f
-reference/chegvx.f reference/dgels.f reference/dsyevx.f reference/sorghr.f reference/zla_herfsx_extended.f
-reference/cherfs.f reference/dgelss.f reference/dsygs2.f reference/sorgl2.f reference/zla_herpvgrw.f
-reference/cherfsx.f reference/dgelsx.f reference/dsygst.f reference/sorglq.f reference/zlahqr.f
-reference/chesv.f reference/dgelsy.f reference/dsygvd.f reference/sorgql.f reference/zlahr2.f
-reference/chesvx.f reference/dgeql2.f reference/dsygv.f reference/sorgqr.f reference/zlahrd.f
-reference/chesvxx.f reference/dgeqlf.f reference/dsygvx.f reference/sorgr2.f reference/zlaic1.f
-reference/chetd2.f reference/dgeqp3.f reference/dsyrfs.f reference/sorgrq.f reference/zla_lin_berr.f
-reference/chetf2.f reference/dgeqpf.f reference/dsyrfsx.f reference/sorgtr.f reference/zlals0.f
-reference/chetrd.f reference/dgeqr2.f reference/dsysv.f reference/sorm2l.f reference/zlalsa.f
-reference/chetrf.f reference/dgeqrf.f reference/dsysvx.f reference/sorm2r.f reference/zlalsd.f
-reference/chetri.f reference/dgerfs.f reference/dsysvxx.f reference/sormbr.f reference/zlangb.f
-reference/chetrs.f reference/dgerfsx.f reference/dsytd2.f reference/sormhr.f reference/zlange.f
-reference/chfrk.f reference/dgerq2.f reference/dsytf2.f reference/sorml2.f reference/zlangt.f
-reference/chgeqz.f reference/dgerqf.f reference/dsytrd.f reference/sormlq.f reference/zlanhb.f
-reference/chla_transtype.f reference/dgesc2.f reference/dsytrf.f reference/sormql.f reference/zlanhe.f
-reference/chpcon.f reference/dgesdd.f reference/dsytri.f reference/sormqr.f reference/zlanhf.f
-reference/chpevd.f reference/dgesvd.f reference/dsytrs.f reference/sormr2.f reference/zlanhp.f
-reference/chpev.f reference/dgesv.f reference/dtbcon.f reference/sormr3.f reference/zlanhs.f
-reference/chpevx.f reference/dgesvj.f reference/dtbrfs.f reference/sormrq.f reference/zlanht.f
-reference/chpgst.f reference/dgesvx.f reference/dtbtrs.f reference/sormrz.f reference/zlansb.f
-reference/chpgvd.f reference/dgesvxx.f reference/dtfsm.f reference/sormtr.f reference/zlansp.f
-reference/chpgv.f reference/dgetc2.f reference/dtftri.f reference/spbcon.f reference/zlansy.f
-reference/chpgvx.f reference/dgetf2.f reference/dtfttp.f reference/spbequ.f reference/zlantb.f
-reference/chprfs.f
-reference/dtfttr.f reference/spbrfs.f reference/zlantp.f
-reference/chpsv.f reference/dgetri.f reference/dtgevc.f reference/spbstf.f reference/zlantr.f
-reference/chpsvx.f reference/dtgex2.f reference/spbsv.f reference/zlapll.f
-reference/chptrd.f reference/dggbak.f reference/dtgexc.f reference/spbsvx.f reference/zlapmt.f
-reference/chptrf.f reference/dggbal.f reference/dtgsen.f reference/spbtf2.f reference/zla_porcond_c.f
-reference/chptri.f reference/dgges.f reference/dtgsja.f reference/spbtrf.f reference/zla_porcond_x.f
-reference/chptrs.f reference/dggesx.f reference/dtgsna.f reference/spbtrs.f reference/zla_porfsx_extended.f
-reference/chsein.f reference/dggev.f reference/dtgsy2.f reference/spftrf.f reference/zla_porpvgrw.f
-reference/chseqr.f reference/dggevx.f reference/dtgsyl.f reference/spftri.f reference/zlaqgb.f
-reference/clabrd.f reference/dggglm.f reference/dtpcon.f reference/spftrs.f reference/zlaqge.f
-reference/clacgv.f reference/dgghrd.f reference/dtprfs.f reference/spocon.f reference/zlaqhb.f
-reference/clacn2.f reference/dgglse.f reference/dtptri.f reference/spoequb.f reference/zlaqhe.f
-reference/clacon.f reference/dggqrf.f reference/dtptrs.f reference/spoequ.f reference/zlaqhp.f
-reference/clacp2.f reference/dggrqf.f reference/dtpttf.f reference/sporfs.f reference/zlaqp2.f
-reference/clacpy.f reference/dggsvd.f reference/dtpttr.f reference/sporfsx.f reference/zlaqps.f
-reference/clacrm.f reference/dggsvp.f reference/dtrcon.f reference/sposv.f reference/zlaqr0.f
-reference/clacrt.f reference/dgsvj0.f reference/dtrevc.f reference/sposvx.f reference/zlaqr1.f
-reference/cladiv.f reference/dgsvj1.f reference/dtrexc.f reference/sposvxx.f reference/zlaqr2.f
-reference/claed0.f reference/dgtcon.f reference/dtrrfs.f reference/spotf2.f reference/zlaqr3.f
-reference/claed7.f reference/dgtrfs.f reference/dtrsen.f
-reference/zlaqr4.f
-reference/claed8.f reference/dgtsv.f reference/dtrsna.f reference/spotri.f reference/zlaqr5.f
-reference/claein.f reference/dgtsvx.f reference/dtrsyl.f reference/zlaqsb.f
-reference/claesy.f reference/dgttrf.f reference/dtrti2.f reference/sppcon.f reference/zlaqsp.f
-reference/claev2.f reference/dgttrs.f reference/dtrtri.f reference/sppequ.f reference/zlaqsy.f
-reference/clag2z.f reference/dgtts2.f reference/dtrtrs.f reference/spprfs.f reference/zlar1v.f
-reference/cla_gbamv.f reference/dhgeqz.f reference/dtrttf.f reference/sppsv.f reference/zlar2v.f
-reference/cla_gbrcond_c.f reference/dhsein.f reference/dtrttp.f reference/sppsvx.f reference/zlarcm.f
-reference/cla_gbrcond_x.f reference/dhseqr.f reference/dtzrqf.f reference/spptrf.f reference/zlarfb.f
-reference/cla_gbrfsx_extended.f reference/disnan.f reference/dtzrzf.f reference/spptri.f reference/zlarf.f
-reference/cla_gbrpvgrw.f reference/dlabad.f reference/dzsum1.f reference/spptrs.f reference/zlarfg.f
-reference/cla_geamv.f reference/dlabrd.f reference/icmax1.f reference/spstf2.f reference/zlarfp.f
-reference/cla_gercond_c.f reference/dlacn2.f reference/ieeeck.f reference/spstrf.f reference/zlarft.f
-reference/cla_gercond_x.f reference/dlacon.f reference/ilaclc.f reference/sptcon.f reference/zlarfx.f
-reference/cla_gerfsx_extended.f reference/dlacpy.f reference/ilaclr.f reference/spteqr.f reference/zlargv.f
-reference/clags2.f reference/dladiv.f reference/iladiag.f reference/sptrfs.f reference/zlarnv.f
-reference/clagtm.f reference/dlae2.f reference/iladlc.f reference/sptsv.f reference/zla_rpvgrw.f
-reference/cla_heamv.f reference/dlaebz.f reference/iladlr.f reference/sptsvx.f reference/zlarrv.f
-reference/clahef.f reference/dlaed0.f reference/ilaenv.f reference/spttrf.f reference/zlarscl2.f
-reference/cla_hercond_c.f reference/dlaed1.f reference/ilaprec.f reference/spttrs.f reference/zlartg.f
-reference/cla_hercond_x.f reference/dlaed2.f reference/ilaslc.f reference/sptts2.f reference/zlartv.f
-reference/cla_herfsx_extended.f reference/dlaed3.f reference/ilaslr.f reference/srscl.f reference/zlarzb.f
-reference/cla_herpvgrw.f reference/dlaed4.f reference/ilatrans.f reference/ssbevd.f reference/zlarz.f
-reference/clahqr.f reference/dlaed5.f reference/ilauplo.f reference/ssbev.f reference/zlarzt.f
-reference/clahr2.f reference/dlaed6.f reference/ilaver.f reference/ssbevx.f reference/zlascl2.f
-reference/clahrd.f reference/dlaed7.f reference/ilazlc.f reference/ssbgst.f reference/zlascl.f
-reference/claic1.f reference/dlaed8.f reference/ilazlr.f reference/ssbgvd.f reference/zlaset.f
-reference/cla_lin_berr.f reference/dlaed9.f reference/iparmq.f reference/ssbgv.f reference/zlasr.f
-reference/clals0.f reference/dlaeda.f reference/izmax1.f reference/ssbgvx.f reference/zlassq.f
-reference/clalsa.f reference/dlaein.f reference/lsamen.f reference/ssbtrd.f reference/zlaswp.f
-reference/clalsd.f reference/dlaev2.f reference/sbdsdc.f reference/ssfrk.f reference/zla_syamv.f
-reference/clangb.f reference/dlaexc.f reference/sbdsqr.f reference/sspcon.f reference/zlasyf.f
-reference/clange.f reference/dlag2.f reference/scsum1.f reference/sspevd.f reference/zla_syrcond_c.f
-reference/clangt.f reference/dlag2s.f reference/sdisna.f reference/sspev.f reference/zla_syrcond_x.f
-reference/clanhb.f reference/dla_gbamv.f reference/sgbbrd.f reference/sspevx.f reference/zla_syrfsx_extended.f
-reference/clanhe.f reference/dla_gbrcond.f reference/sgbcon.f reference/sspgst.f reference/zla_syrpvgrw.f
-reference/clanhf.f reference/dla_gbrfsx_extended.f reference/sgbequb.f reference/sspgvd.f reference/zlat2c.f
-reference/clanhp.f reference/dla_gbrpvgrw.f reference/sgbequ.f reference/sspgv.f reference/zlatbs.f
-reference/clanhs.f reference/dla_geamv.f reference/sgbrfs.f reference/sspgvx.f reference/zlatdf.f
-reference/clanht.f reference/dla_gercond.f reference/sgbrfsx.f reference/ssprfs.f reference/zlatps.f
-reference/clansb.f reference/dla_gerfsx_extended.f reference/sgbsv.f reference/sspsv.f reference/zlatrd.f
-reference/clansp.f reference/dlags2.f reference/sgbsvx.f reference/sspsvx.f reference/zlatrs.f
-reference/clansy.f reference/dlagtf.f reference/sgbsvxx.f reference/ssptrd.f reference/zlatrz.f
-reference/clantb.f reference/dlagtm.f reference/sgbtf2.f reference/ssptrf.f reference/zlatzm.f
-reference/clantp.f reference/dlagts.f reference/sgbtrf.f reference/ssptri.f reference/zlauu2.f
-reference/clantr.f reference/dlagv2.f reference/sgbtrs.f reference/ssptrs.f reference/zlauum.f
-reference/clapll.f reference/dlahqr.f reference/sgebak.f reference/sstebz.f reference/zla_wwaddw.f
-reference/clapmt.f reference/dlahr2.f reference/sgebal.f reference/sstedc.f reference/zpbcon.f
-reference/cla_porcond_c.f reference/dlahrd.f reference/sgebd2.f reference/sstegr.f reference/zpbequ.f
-reference/cla_porcond_x.f reference/dlaic1.f reference/sgebrd.f reference/sstein.f reference/zpbrfs.f
-reference/cla_porfsx_extended.f reference/dlaisnan.f reference/sgecon.f reference/sstemr.f reference/zpbstf.f
-reference/cla_porpvgrw.f reference/dla_lin_berr.f reference/sgeequb.f reference/ssteqr.f reference/zpbsv.f
-reference/claqgb.f reference/dlaln2.f reference/sgeequ.f reference/ssterf.f reference/zpbsvx.f
-reference/claqge.f reference/dlals0.f reference/sgees.f reference/sstevd.f reference/zpbtf2.f
-reference/claqhb.f reference/dlalsa.f reference/sgeesx.f reference/sstev.f reference/zpbtrf.f
-reference/claqhe.f reference/dlalsd.f reference/sgeev.f reference/sstevr.f reference/zpbtrs.f
-reference/claqhp.f reference/dlamrg.f reference/sgeevx.f reference/sstevx.f reference/zpftrf.f
-reference/claqp2.f reference/dlaneg.f reference/sgegs.f reference/ssycon.f reference/zpftri.f
-reference/claqps.f reference/dlangb.f reference/sgegv.f reference/ssyequb.f reference/zpftrs.f
-reference/claqr0.f reference/dlange.f reference/sgehd2.f reference/ssyevd.f reference/zpocon.f
-reference/claqr1.f reference/dlangt.f reference/sgehrd.f reference/zpoequb.f
-reference/claqr2.f reference/dlanhs.f reference/sgejsv.f reference/ssyevr.f reference/zpoequ.f
-reference/claqr3.f reference/dlansb.f reference/sgelq2.f reference/ssyevx.f reference/zporfs.f
-reference/claqr4.f reference/dlansf.f reference/sgelqf.f reference/ssygs2.f reference/zporfsx.f
-reference/claqr5.f reference/dlansp.f reference/sgelsd.f reference/ssygst.f reference/zposv.f
-reference/claqsb.f reference/dlanst.f reference/sgels.f reference/ssygvd.f reference/zposvx.f
-reference/claqsp.f reference/dlansy.f reference/sgelss.f reference/ssygv.f reference/zposvxx.f
-reference/claqsy.f reference/dlantb.f reference/sgelsx.f reference/ssygvx.f reference/zpotf2.f
-reference/clar1v.f reference/dlantp.f reference/sgelsy.f reference/ssyrfs.f
-reference/clar2v.f reference/dlantr.f reference/sgeql2.f reference/ssyrfsx.f reference/zpotri.f
-reference/clarcm.f reference/dlanv2.f reference/sgeqlf.f reference/ssysv.f
-reference/clarfb.f reference/dlapll.f reference/sgeqp3.f reference/ssysvx.f reference/zppcon.f
-reference/clarf.f reference/dlapmt.f reference/sgeqpf.f reference/ssysvxx.f reference/zppequ.f
-reference/clarfg.f reference/dla_porcond.f reference/sgeqr2.f reference/ssytd2.f reference/zpprfs.f
-reference/clarfp.f reference/dla_porfsx_extended.f reference/sgeqrf.f reference/ssytf2.f reference/zppsv.f
-reference/clarft.f reference/dla_porpvgrw.f reference/sgerfs.f reference/ssytrd.f reference/zppsvx.f
-reference/clarfx.f reference/dlapy2.f reference/sgerfsx.f reference/ssytrf.f reference/zpptrf.f
-reference/clargv.f reference/dlapy3.f reference/sgerq2.f reference/ssytri.f reference/zpptri.f
-reference/clarnv.f reference/dlaqgb.f reference/sgerqf.f reference/ssytrs.f reference/zpptrs.f
-reference/cla_rpvgrw.f reference/dlaqge.f reference/sgesc2.f reference/stbcon.f reference/zpstf2.f
-reference/clarrv.f reference/dlaqp2.f reference/sgesdd.f reference/stbrfs.f reference/zpstrf.f
-reference/clarscl2.f reference/dlaqps.f reference/sgesvd.f reference/stbtrs.f reference/zptcon.f
-reference/clartg.f reference/dlaqr0.f reference/sgesv.f reference/stfsm.f reference/zpteqr.f
-reference/clartv.f reference/dlaqr1.f reference/sgesvj.f reference/stftri.f reference/zptrfs.f
-reference/clarzb.f reference/dlaqr2.f reference/sgesvx.f reference/stfttp.f reference/zptsv.f
-reference/clarz.f reference/dlaqr3.f reference/sgesvxx.f reference/stfttr.f reference/zptsvx.f
-reference/clarzt.f reference/dlaqr4.f reference/sgetc2.f reference/stgevc.f reference/zpttrf.f
-reference/clascl2.f reference/dlaqr5.f reference/sgetf2.f reference/stgex2.f reference/zpttrs.f
-reference/clascl.f reference/dlaqsb.f
-reference/stgexc.f reference/zptts2.f
-reference/claset.f reference/dlaqsp.f reference/sgetri.f reference/stgsen.f reference/zrot.f
-reference/clasr.f reference/dlaqsy.f reference/stgsja.f reference/zspcon.f
-reference/classq.f reference/dlaqtr.f reference/sggbak.f reference/stgsna.f reference/zspmv.f
-reference/claswp.f reference/dlar1v.f reference/sggbal.f reference/stgsy2.f reference/zspr.f
-reference/cla_syamv.f reference/dlar2v.f reference/sgges.f reference/stgsyl.f reference/zsprfs.f
-reference/clasyf.f reference/dlarfb.f reference/sggesx.f reference/stpcon.f reference/zspsv.f
-reference/cla_syrcond_c.f reference/dlarf.f reference/sggev.f reference/stprfs.f reference/zspsvx.f
-reference/cla_syrcond_x.f reference/dlarfg.f reference/sggevx.f reference/stptri.f reference/zsptrf.f
-reference/cla_syrfsx_extended.f reference/dlarfp.f reference/sggglm.f reference/stptrs.f reference/zsptri.f
-reference/cla_syrpvgrw.f reference/dlarft.f reference/sgghrd.f reference/stpttf.f reference/zsptrs.f
-reference/clatbs.f reference/dlarfx.f reference/sgglse.f reference/stpttr.f reference/zstedc.f
-reference/clatdf.f reference/dlargv.f reference/sggqrf.f reference/strcon.f reference/zstegr.f
-reference/clatps.f reference/dlarnv.f reference/sggrqf.f reference/strevc.f reference/zstein.f
-reference/clatrd.f reference/dla_rpvgrw.f reference/sggsvd.f reference/strexc.f reference/zstemr.f
-reference/clatrs.f reference/dlarra.f reference/sggsvp.f reference/strrfs.f reference/zsteqr.f
-reference/clatrz.f reference/dlarrb.f reference/sgsvj0.f reference/strsen.f reference/zsycon.f
-reference/clatzm.f reference/dlarrc.f reference/sgsvj1.f reference/strsna.f reference/zsyequb.f
-reference/clauu2.f reference/dlarrd.f reference/sgtcon.f reference/strsyl.f reference/zsymv.f
-reference/clauum.f reference/dlarre.f reference/sgtrfs.f reference/strti2.f reference/zsyr.f
-reference/cla_wwaddw.f reference/dlarrf.f reference/sgtsv.f reference/strtri.f reference/zsyrfs.f
-reference/cpbcon.f reference/dlarrj.f reference/sgtsvx.f reference/strtrs.f reference/zsyrfsx.f
-reference/cpbequ.f reference/dlarrk.f reference/sgttrf.f reference/strttf.f reference/zsysv.f
-reference/cpbrfs.f reference/dlarrr.f reference/sgttrs.f reference/strttp.f reference/zsysvx.f
-reference/cpbstf.f reference/dlarrv.f reference/sgtts2.f reference/stzrqf.f reference/zsysvxx.f
-reference/cpbsv.f reference/dlarscl2.f reference/shgeqz.f reference/stzrzf.f reference/zsytf2.f
-reference/cpbsvx.f reference/dlartg.f reference/shsein.f reference/xerbla_array.f reference/zsytrf.f
-reference/cpbtf2.f reference/dlartv.f reference/shseqr.f reference/xerbla.f reference/zsytri.f
-reference/cpbtrf.f reference/dlaruv.f reference/sisnan.f reference/zbdsqr.f reference/zsytrs.f
-reference/cpbtrs.f reference/dlarzb.f reference/slabad.f reference/zcgesv.f reference/ztbcon.f
-reference/cpftrf.f reference/dlarz.f reference/slabrd.f reference/zcposv.f reference/ztbrfs.f
-reference/cpftri.f reference/dlarzt.f reference/slacn2.f reference/zdrscl.f reference/ztbtrs.f
-reference/cpftrs.f reference/dlas2.f reference/slacon.f reference/zgbbrd.f reference/ztfsm.f
-reference/cpocon.f reference/dlascl2.f reference/slacpy.f reference/zgbcon.f reference/ztftri.f
-reference/cpoequb.f reference/dlascl.f reference/sladiv.f reference/zgbequb.f reference/ztfttp.f
-reference/cpoequ.f reference/dlasd0.f reference/slae2.f reference/zgbequ.f reference/ztfttr.f
-reference/cporfs.f reference/dlasd1.f reference/slaebz.f reference/zgbrfs.f reference/ztgevc.f
-reference/cporfsx.f reference/dlasd2.f reference/slaed0.f reference/zgbrfsx.f reference/ztgex2.f
-reference/cposv.f reference/dlasd3.f reference/slaed1.f reference/zgbsv.f reference/ztgexc.f
-reference/cposvx.f reference/dlasd4.f reference/slaed2.f reference/zgbsvx.f reference/ztgsen.f
-reference/cposvxx.f reference/dlasd5.f reference/slaed3.f reference/zgbsvxx.f reference/ztgsja.f
-reference/cpotf2.f reference/dlasd6.f reference/slaed4.f reference/zgbtf2.f reference/ztgsna.f
-reference/dlasd7.f reference/slaed5.f reference/zgbtrf.f reference/ztgsy2.f
-reference/cpotri.f reference/dlasd8.f reference/slaed6.f reference/zgbtrs.f reference/ztgsyl.f
- reference/dlasda.f reference/slaed7.f reference/zgebak.f reference/ztpcon.f
-reference/cppcon.f reference/dlasdq.f reference/slaed8.f reference/zgebal.f reference/ztprfs.f
-reference/cppequ.f reference/dlasdt.f reference/slaed9.f reference/zgebd2.f reference/ztptri.f
-reference/cpprfs.f reference/dlaset.f reference/slaeda.f reference/zgebrd.f reference/ztptrs.f
-reference/cppsv.f reference/dlasq1.f reference/slaein.f reference/zgecon.f reference/ztpttf.f
-reference/cppsvx.f reference/dlasq2.f reference/slaev2.f reference/zgeequb.f reference/ztpttr.f
-reference/cpptrf.f reference/dlasq3.f reference/slaexc.f reference/zgeequ.f reference/ztrcon.f
-reference/cpptri.f reference/dlasq4.f reference/slag2d.f reference/zgees.f reference/ztrevc.f
-reference/cpptrs.f reference/dlasq5.f reference/slag2.f reference/zgeesx.f reference/ztrexc.f
-reference/cpstf2.f reference/dlasq6.f reference/sla_gbamv.f reference/zgeev.f reference/ztrrfs.f
-reference/cpstrf.f reference/dlasr.f reference/sla_gbrcond.f reference/zgeevx.f reference/ztrsen.f
-reference/cptcon.f reference/dlasrt.f reference/sla_gbrfsx_extended.f reference/zgegs.f reference/ztrsna.f
-reference/cpteqr.f reference/dlassq.f reference/sla_gbrpvgrw.f reference/zgegv.f reference/ztrsyl.f
-reference/cptrfs.f reference/dlasv2.f reference/sla_geamv.f reference/zgehd2.f reference/ztrti2.f
-reference/cptsv.f reference/dlaswp.f reference/sla_gercond.f reference/zgehrd.f reference/ztrtri.f
-reference/cptsvx.f reference/dlasy2.f reference/sla_gerfsx_extended.f reference/zgelq2.f reference/ztrtrs.f
-reference/cpttrf.f reference/dla_syamv.f reference/slags2.f reference/zgelqf.f reference/ztrttf.f
-reference/cpttrs.f reference/dlasyf.f reference/slagtf.f reference/zgelsd.f reference/ztrttp.f
-reference/cptts2.f reference/dla_syrcond.f reference/slagtm.f reference/zgels.f reference/ztzrqf.f
-reference/crot.f reference/dla_syrfsx_extended.f reference/slagts.f reference/zgelss.f reference/ztzrzf.f
-reference/cspcon.f reference/dla_syrpvgrw.f reference/slagv2.f reference/zgelsx.f reference/zung2l.f
-reference/cspmv.f reference/dlat2s.f reference/slahqr.f reference/zgelsy.f reference/zung2r.f
-reference/cspr.f reference/dlatbs.f reference/slahr2.f reference/zgeql2.f reference/zungbr.f
-reference/csprfs.f reference/dlatdf.f reference/slahrd.f reference/zgeqlf.f reference/zunghr.f
-reference/cspsv.f reference/dlatps.f reference/slaic1.f reference/zgeqp3.f reference/zungl2.f
-reference/cspsvx.f reference/dlatrd.f reference/slaisnan.f reference/zgeqpf.f reference/zunglq.f
-reference/csptrf.f reference/dlatrs.f reference/sla_lin_berr.f reference/zgeqr2.f reference/zungql.f
-reference/csptri.f reference/dlatrz.f reference/slaln2.f reference/zgeqrf.f reference/zungqr.f
-reference/csptrs.f reference/dlatzm.f reference/slals0.f reference/zgerfs.f reference/zungr2.f
-reference/csrscl.f reference/dlauu2.f reference/slalsa.f reference/zgerfsx.f reference/zungrq.f
-reference/cstedc.f reference/dlauum.f reference/slalsd.f reference/zgerq2.f reference/zungtr.f
-reference/cstegr.f reference/dla_wwaddw.f reference/slamrg.f reference/zgerqf.f reference/zunm2l.f
-reference/cstein.f reference/dopgtr.f reference/slaneg.f reference/zgesc2.f reference/zunm2r.f
-reference/cstemr.f reference/dopmtr.f reference/slangb.f reference/zgesdd.f reference/zunmbr.f
-reference/csteqr.f reference/dorg2l.f reference/slange.f reference/zgesvd.f reference/zunmhr.f
-reference/csycon.f reference/dorg2r.f reference/slangt.f reference/zgesv.f reference/zunml2.f
-reference/csyequb.f reference/dorgbr.f reference/slanhs.f reference/zgesvx.f reference/zunmlq.f
-reference/csymv.f reference/dorghr.f reference/slansb.f reference/zgesvxx.f reference/zunmql.f
-reference/csyr.f reference/dorgl2.f reference/slansf.f reference/zgetc2.f reference/zunmqr.f
-reference/csyrfs.f reference/dorglq.f reference/slansp.f reference/zgetf2.f reference/zunmr2.f
-reference/csyrfsx.f reference/dorgql.f reference/slanst.f
-reference/zunmr3.f
-reference/csysv.f reference/dorgqr.f reference/slansy.f reference/zgetri.f reference/zunmrq.f
-reference/csysvx.f reference/dorgr2.f reference/slantb.f reference/zunmrz.f
-reference/csysvxx.f reference/dorgrq.f reference/slantp.f reference/zggbak.f reference/zunmtr.f
-reference/csytf2.f reference/dorgtr.f reference/slantr.f reference/zggbal.f reference/zupgtr.f
-reference/csytrf.f reference/dorm2l.f reference/slanv2.f reference/zgges.f reference/zupmtr.f
-reference/csytri.f reference/dorm2r.f reference/slapll.f reference/zggesx.f
-reference/csytrs.f reference/dormbr.f reference/slapmt.f reference/zggev.f
-reference/ctbcon.f reference/dormhr.f reference/sla_porcond.f reference/zggevx.f
+set(EigenLapack_SRCS ${EigenLapack_SRCS}
+ slarft.f dlarft.f clarft.f zlarft.f
+ slarfb.f dlarfb.f clarfb.f zlarfb.f
+ slarfg.f dlarfg.f clarfg.f zlarfg.f
+ slarf.f dlarf.f clarf.f zlarf.f
+ sladiv.f dladiv.f cladiv.f zladiv.f
+ ilaslr.f iladlr.f ilaclr.f ilazlr.f
+ ilaslc.f iladlc.f ilaclc.f ilazlc.f
+ dlapy2.f dlapy3.f slapy2.f slapy3.f
+ clacgv.f zlacgv.f
+ slamch.f dlamch.f
+ second_NONE.f dsecnd_NONE.f
)
-endif()
+
+option(EIGEN_ENABLE_LAPACK_TESTS OFF "Enbale the Lapack unit tests")
+
+if(EIGEN_ENABLE_LAPACK_TESTS)
+
+ get_filename_component(eigen_full_path_to_reference_lapack "./reference/" ABSOLUTE)
+ if(NOT EXISTS ${eigen_full_path_to_reference_lapack})
+ # Download lapack and install sources and testing at the right place
+ message(STATUS "Download lapack_addons_3.4.1.tgz...")
+
+ file(DOWNLOAD "http://downloads.tuxfamily.org/eigen/lapack_addons_3.4.1.tgz"
+ "${CMAKE_CURRENT_SOURCE_DIR}/lapack_addons_3.4.1.tgz"
+ INACTIVITY_TIMEOUT 15
+ TIMEOUT 240
+ STATUS download_status
+ EXPECTED_MD5 5758ce55afcf79da98de8b9de1615ad5
+ SHOW_PROGRESS)
+
+ message(STATUS ${download_status})
+ list(GET download_status 0 download_status_num)
+ set(download_status_num 0)
+ if(download_status_num EQUAL 0)
+ message(STATUS "Setup lapack reference and lapack unit tests")
+ execute_process(COMMAND tar xzf "lapack_addons_3.4.1.tgz" WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
+ else()
+ message(STATUS "Download of lapack_addons_3.4.1.tgz failed, LAPACK unit tests wont be enabled")
+ set(EIGEN_ENABLE_LAPACK_TESTS false)
+ endif()
+
+ endif()
+
+ get_filename_component(eigen_full_path_to_reference_lapack "./reference/" ABSOLUTE)
+ if(EXISTS ${eigen_full_path_to_reference_lapack})
+ set(EigenLapack_funcfilenames
+ ssyev.f dsyev.f csyev.f zsyev.f
+ spotrf.f dpotrf.f cpotrf.f zpotrf.f
+ spotrs.f dpotrs.f cpotrs.f zpotrs.f
+ sgetrf.f dgetrf.f cgetrf.f zgetrf.f
+ sgetrs.f dgetrs.f cgetrs.f zgetrs.f)
+
+ FILE(GLOB ReferenceLapack_SRCS0 RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} "reference/*.f")
+ foreach(filename1 IN LISTS ReferenceLapack_SRCS0)
+ string(REPLACE "reference/" "" filename ${filename1})
+ list(FIND EigenLapack_SRCS ${filename} id1)
+ list(FIND EigenLapack_funcfilenames ${filename} id2)
+ if((id1 EQUAL -1) AND (id2 EQUAL -1))
+ set(ReferenceLapack_SRCS ${ReferenceLapack_SRCS} reference/${filename})
+ endif()
+ endforeach()
+ endif()
+
+
+endif(EIGEN_ENABLE_LAPACK_TESTS)
endif(EIGEN_Fortran_COMPILER_WORKS)
-add_library(eigen_lapack_static ${EigenLapack_SRCS})
+add_library(eigen_lapack_static ${EigenLapack_SRCS} ${ReferenceLapack_SRCS})
add_library(eigen_lapack SHARED ${EigenLapack_SRCS})
+target_link_libraries(eigen_lapack eigen_blas)
+
if(EIGEN_STANDARD_LIBRARIES_TO_LINK_TO)
target_link_libraries(eigen_lapack_static ${EIGEN_STANDARD_LIBRARIES_TO_LINK_TO})
target_link_libraries(eigen_lapack ${EIGEN_STANDARD_LIBRARIES_TO_LINK_TO})
@@ -370,5 +107,343 @@
LIBRARY DESTINATION lib
ARCHIVE DESTINATION lib)
-# add_subdirectory(testing)
+
+
+get_filename_component(eigen_full_path_to_testing_lapack "./testing/" ABSOLUTE)
+if(EXISTS ${eigen_full_path_to_testing_lapack})
+
+ # The following comes from lapack/TESTING/CMakeLists.txt
+ # Get Python
+ find_package(PythonInterp)
+ message(STATUS "Looking for Python found - ${PYTHONINTERP_FOUND}")
+ if (PYTHONINTERP_FOUND)
+ message(STATUS "Using Python version ${PYTHON_VERSION_STRING}")
+ endif()
+
+ set(LAPACK_SOURCE_DIR ${CMAKE_CURRENT_SOURCE_DIR})
+ set(LAPACK_BINARY_DIR ${CMAKE_CURRENT_BINARY_DIR})
+ set(BUILD_SINGLE true)
+ set(BUILD_DOUBLE true)
+ set(BUILD_COMPLEX true)
+ set(BUILD_COMPLEX16E true)
+
+ if(MSVC_VERSION)
+# string(REPLACE "/STACK:10000000" "/STACK:900000000000000000"
+# CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS}")
+ string(REGEX REPLACE "(.*)/STACK:(.*) (.*)" "\\1/STACK:900000000000000000 \\3"
+ CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS}")
+ endif()
+ add_subdirectory(testing/MATGEN)
+ add_subdirectory(testing/LIN)
+ add_subdirectory(testing/EIG)
+ macro(add_lapack_test output input target)
+ set(TEST_INPUT "${LAPACK_SOURCE_DIR}/testing/${input}")
+ set(TEST_OUTPUT "${LAPACK_BINARY_DIR}/testing/${output}")
+ get_target_property(TEST_LOC ${target} LOCATION)
+ string(REPLACE "." "_" input_name ${input})
+ set(testName "${target}_${input_name}")
+ if(EXISTS "${TEST_INPUT}")
+ add_test(LAPACK-${testName} "${CMAKE_COMMAND}"
+ -DTEST=${TEST_LOC}
+ -DINPUT=${TEST_INPUT}
+ -DOUTPUT=${TEST_OUTPUT}
+ -DINTDIR=${CMAKE_CFG_INTDIR}
+ -P "${LAPACK_SOURCE_DIR}/testing/runtest.cmake")
+ endif()
+ endmacro(add_lapack_test)
+
+ if (BUILD_SINGLE)
+ add_lapack_test(stest.out stest.in xlintsts)
+ #
+ # ======== SINGLE RFP LIN TESTS ========================
+ add_lapack_test(stest_rfp.out stest_rfp.in xlintstrfs)
+ #
+ #
+ # ======== SINGLE EIG TESTS ===========================
+ #
+
+ add_lapack_test(snep.out nep.in xeigtsts)
+
+
+ add_lapack_test(ssep.out sep.in xeigtsts)
+
+
+ add_lapack_test(ssvd.out svd.in xeigtsts)
+
+
+ add_lapack_test(sec.out sec.in xeigtsts)
+
+
+ add_lapack_test(sed.out sed.in xeigtsts)
+
+
+ add_lapack_test(sgg.out sgg.in xeigtsts)
+
+
+ add_lapack_test(sgd.out sgd.in xeigtsts)
+
+
+ add_lapack_test(ssb.out ssb.in xeigtsts)
+
+
+ add_lapack_test(ssg.out ssg.in xeigtsts)
+
+
+ add_lapack_test(sbal.out sbal.in xeigtsts)
+
+
+ add_lapack_test(sbak.out sbak.in xeigtsts)
+
+
+ add_lapack_test(sgbal.out sgbal.in xeigtsts)
+
+
+ add_lapack_test(sgbak.out sgbak.in xeigtsts)
+
+
+ add_lapack_test(sbb.out sbb.in xeigtsts)
+
+
+ add_lapack_test(sglm.out glm.in xeigtsts)
+
+
+ add_lapack_test(sgqr.out gqr.in xeigtsts)
+
+
+ add_lapack_test(sgsv.out gsv.in xeigtsts)
+
+
+ add_lapack_test(scsd.out csd.in xeigtsts)
+
+
+ add_lapack_test(slse.out lse.in xeigtsts)
+ endif()
+
+ if (BUILD_DOUBLE)
+ #
+ # ======== DOUBLE LIN TESTS ===========================
+ add_lapack_test(dtest.out dtest.in xlintstd)
+ #
+ # ======== DOUBLE RFP LIN TESTS ========================
+ add_lapack_test(dtest_rfp.out dtest_rfp.in xlintstrfd)
+ #
+ # ======== DOUBLE EIG TESTS ===========================
+
+ add_lapack_test(dnep.out nep.in xeigtstd)
+
+
+ add_lapack_test(dsep.out sep.in xeigtstd)
+
+
+ add_lapack_test(dsvd.out svd.in xeigtstd)
+
+
+ add_lapack_test(dec.out dec.in xeigtstd)
+
+
+ add_lapack_test(ded.out ded.in xeigtstd)
+
+
+ add_lapack_test(dgg.out dgg.in xeigtstd)
+
+
+ add_lapack_test(dgd.out dgd.in xeigtstd)
+
+
+ add_lapack_test(dsb.out dsb.in xeigtstd)
+
+
+ add_lapack_test(dsg.out dsg.in xeigtstd)
+
+
+ add_lapack_test(dbal.out dbal.in xeigtstd)
+
+
+ add_lapack_test(dbak.out dbak.in xeigtstd)
+
+
+ add_lapack_test(dgbal.out dgbal.in xeigtstd)
+
+
+ add_lapack_test(dgbak.out dgbak.in xeigtstd)
+
+
+ add_lapack_test(dbb.out dbb.in xeigtstd)
+
+
+ add_lapack_test(dglm.out glm.in xeigtstd)
+
+
+ add_lapack_test(dgqr.out gqr.in xeigtstd)
+
+
+ add_lapack_test(dgsv.out gsv.in xeigtstd)
+
+
+ add_lapack_test(dcsd.out csd.in xeigtstd)
+
+
+ add_lapack_test(dlse.out lse.in xeigtstd)
+ endif()
+
+ if (BUILD_COMPLEX)
+ add_lapack_test(ctest.out ctest.in xlintstc)
+ #
+ # ======== COMPLEX RFP LIN TESTS ========================
+ add_lapack_test(ctest_rfp.out ctest_rfp.in xlintstrfc)
+ #
+ # ======== COMPLEX EIG TESTS ===========================
+
+ add_lapack_test(cnep.out nep.in xeigtstc)
+
+
+ add_lapack_test(csep.out sep.in xeigtstc)
+
+
+ add_lapack_test(csvd.out svd.in xeigtstc)
+
+
+ add_lapack_test(cec.out cec.in xeigtstc)
+
+
+ add_lapack_test(ced.out ced.in xeigtstc)
+
+
+ add_lapack_test(cgg.out cgg.in xeigtstc)
+
+
+ add_lapack_test(cgd.out cgd.in xeigtstc)
+
+
+ add_lapack_test(csb.out csb.in xeigtstc)
+
+
+ add_lapack_test(csg.out csg.in xeigtstc)
+
+
+ add_lapack_test(cbal.out cbal.in xeigtstc)
+
+
+ add_lapack_test(cbak.out cbak.in xeigtstc)
+
+
+ add_lapack_test(cgbal.out cgbal.in xeigtstc)
+
+
+ add_lapack_test(cgbak.out cgbak.in xeigtstc)
+
+
+ add_lapack_test(cbb.out cbb.in xeigtstc)
+
+
+ add_lapack_test(cglm.out glm.in xeigtstc)
+
+
+ add_lapack_test(cgqr.out gqr.in xeigtstc)
+
+
+ add_lapack_test(cgsv.out gsv.in xeigtstc)
+
+
+ add_lapack_test(ccsd.out csd.in xeigtstc)
+
+
+ add_lapack_test(clse.out lse.in xeigtstc)
+ endif()
+
+ if (BUILD_COMPLEX16)
+ #
+ # ======== COMPLEX16 LIN TESTS ========================
+ add_lapack_test(ztest.out ztest.in xlintstz)
+ #
+ # ======== COMPLEX16 RFP LIN TESTS ========================
+ add_lapack_test(ztest_rfp.out ztest_rfp.in xlintstrfz)
+ #
+ # ======== COMPLEX16 EIG TESTS ===========================
+
+ add_lapack_test(znep.out nep.in xeigtstz)
+
+
+ add_lapack_test(zsep.out sep.in xeigtstz)
+
+
+ add_lapack_test(zsvd.out svd.in xeigtstz)
+
+
+ add_lapack_test(zec.out zec.in xeigtstz)
+
+
+ add_lapack_test(zed.out zed.in xeigtstz)
+
+
+ add_lapack_test(zgg.out zgg.in xeigtstz)
+
+
+ add_lapack_test(zgd.out zgd.in xeigtstz)
+
+
+ add_lapack_test(zsb.out zsb.in xeigtstz)
+
+
+ add_lapack_test(zsg.out zsg.in xeigtstz)
+
+
+ add_lapack_test(zbal.out zbal.in xeigtstz)
+
+
+ add_lapack_test(zbak.out zbak.in xeigtstz)
+
+
+ add_lapack_test(zgbal.out zgbal.in xeigtstz)
+
+
+ add_lapack_test(zgbak.out zgbak.in xeigtstz)
+
+
+ add_lapack_test(zbb.out zbb.in xeigtstz)
+
+
+ add_lapack_test(zglm.out glm.in xeigtstz)
+
+
+ add_lapack_test(zgqr.out gqr.in xeigtstz)
+
+
+ add_lapack_test(zgsv.out gsv.in xeigtstz)
+
+
+ add_lapack_test(zcsd.out csd.in xeigtstz)
+
+
+ add_lapack_test(zlse.out lse.in xeigtstz)
+ endif()
+
+
+ if (BUILD_SIMPLE)
+ if (BUILD_DOUBLE)
+ #
+ # ======== SINGLE-DOUBLE PROTO LIN TESTS ==============
+ add_lapack_test(dstest.out dstest.in xlintstds)
+ endif()
+ endif()
+
+
+ if (BUILD_COMPLEX)
+ if (BUILD_COMPLEX16)
+ #
+ # ======== COMPLEX-COMPLEX16 LIN TESTS ========================
+ add_lapack_test(zctest.out zctest.in xlintstzc)
+ endif()
+ endif()
+
+ # ==============================================================================
+
+ execute_process(COMMAND ${CMAKE_COMMAND} -E copy ${LAPACK_SOURCE_DIR}/testing/lapack_testing.py ${LAPACK_BINARY_DIR})
+ add_test(
+ NAME LAPACK_Test_Summary
+ WORKING_DIRECTORY ${LAPACK_BINARY_DIR}
+ COMMAND ${PYTHON_EXECUTABLE} "lapack_testing.py"
+ )
+
+endif()
diff --git a/lapack/cholesky.cpp b/lapack/cholesky.cpp
index 604fa43..ea3bc12 100644
--- a/lapack/cholesky.cpp
+++ b/lapack/cholesky.cpp
@@ -26,8 +26,8 @@
Scalar* a = reinterpret_cast<Scalar*>(pa);
MatrixType A(a,*n,*n,*lda);
int ret;
- if(UPLO(*uplo)==UP) ret = internal::llt_inplace<Scalar, Upper>::blocked(A);
- else ret = internal::llt_inplace<Scalar, Lower>::blocked(A);
+ if(UPLO(*uplo)==UP) ret = int(internal::llt_inplace<Scalar, Upper>::blocked(A));
+ else ret = int(internal::llt_inplace<Scalar, Lower>::blocked(A));
if(ret>=0)
*info = ret+1;
diff --git a/lapack/clacgv.f b/lapack/clacgv.f
new file mode 100644
index 0000000..359eb07
--- /dev/null
+++ b/lapack/clacgv.f
@@ -0,0 +1,116 @@
+*> \brief \b CLACGV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLACGV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clacgv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clacgv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clacgv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CLACGV( N, X, INCX )
+*
+* .. Scalar Arguments ..
+* INTEGER INCX, N
+* ..
+* .. Array Arguments ..
+* COMPLEX X( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CLACGV conjugates a complex vector of length N.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The length of the vector X. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*> X is COMPLEX array, dimension
+*> (1+(N-1)*abs(INCX))
+*> On entry, the vector of length N to be conjugated.
+*> On exit, X is overwritten with conjg(X).
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> The spacing between successive elements of X.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complexOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE CLACGV( N, X, INCX )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+* ..
+* .. Array Arguments ..
+ COMPLEX X( * )
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, IOFF
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CONJG
+* ..
+* .. Executable Statements ..
+*
+ IF( INCX.EQ.1 ) THEN
+ DO 10 I = 1, N
+ X( I ) = CONJG( X( I ) )
+ 10 CONTINUE
+ ELSE
+ IOFF = 1
+ IF( INCX.LT.0 )
+ $ IOFF = 1 - ( N-1 )*INCX
+ DO 20 I = 1, N
+ X( IOFF ) = CONJG( X( IOFF ) )
+ IOFF = IOFF + INCX
+ 20 CONTINUE
+ END IF
+ RETURN
+*
+* End of CLACGV
+*
+ END
diff --git a/lapack/cladiv.f b/lapack/cladiv.f
new file mode 100644
index 0000000..2807ac5
--- /dev/null
+++ b/lapack/cladiv.f
@@ -0,0 +1,97 @@
+*> \brief \b CLADIV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLADIV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cladiv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cladiv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cladiv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* COMPLEX FUNCTION CLADIV( X, Y )
+*
+* .. Scalar Arguments ..
+* COMPLEX X, Y
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CLADIV := X / Y, where X and Y are complex. The computation of X / Y
+*> will not overflow on an intermediary step unless the results
+*> overflows.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] X
+*> \verbatim
+*> X is COMPLEX
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*> Y is COMPLEX
+*> The complex scalars X and Y.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complexOTHERauxiliary
+*
+* =====================================================================
+ COMPLEX FUNCTION CLADIV( X, Y )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ COMPLEX X, Y
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ REAL ZI, ZR
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLADIV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC AIMAG, CMPLX, REAL
+* ..
+* .. Executable Statements ..
+*
+ CALL SLADIV( REAL( X ), AIMAG( X ), REAL( Y ), AIMAG( Y ), ZR,
+ $ ZI )
+ CLADIV = CMPLX( ZR, ZI )
+*
+ RETURN
+*
+* End of CLADIV
+*
+ END
diff --git a/lapack/clarf.f b/lapack/clarf.f
new file mode 100644
index 0000000..ca0328f
--- /dev/null
+++ b/lapack/clarf.f
@@ -0,0 +1,232 @@
+*> \brief \b CLARF
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLARF + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarf.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarf.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarf.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER SIDE
+* INTEGER INCV, LDC, M, N
+* COMPLEX TAU
+* ..
+* .. Array Arguments ..
+* COMPLEX C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CLARF applies a complex elementary reflector H to a complex M-by-N
+*> matrix C, from either the left or the right. H is represented in the
+*> form
+*>
+*> H = I - tau * v * v**H
+*>
+*> where tau is a complex scalar and v is a complex vector.
+*>
+*> If tau = 0, then H is taken to be the unit matrix.
+*>
+*> To apply H**H (the conjugate transpose of H), supply conjg(tau) instead
+*> tau.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is CHARACTER*1
+*> = 'L': form H * C
+*> = 'R': form C * H
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is COMPLEX array, dimension
+*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+*> The vector v in the representation of H. V is not used if
+*> TAU = 0.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*> INCV is INTEGER
+*> The increment between elements of v. INCV <> 0.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*> TAU is COMPLEX
+*> The value tau in the representation of H.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is COMPLEX array, dimension (LDC,N)
+*> On entry, the M-by-N matrix C.
+*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+*> or C * H if SIDE = 'R'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX array, dimension
+*> (N) if SIDE = 'L'
+*> or (M) if SIDE = 'R'
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complexOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE CLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE
+ INTEGER INCV, LDC, M, N
+ COMPLEX TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX ONE, ZERO
+ PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ),
+ $ ZERO = ( 0.0E+0, 0.0E+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL APPLYLEFT
+ INTEGER I, LASTV, LASTC
+* ..
+* .. External Subroutines ..
+ EXTERNAL CGEMV, CGERC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILACLR, ILACLC
+ EXTERNAL LSAME, ILACLR, ILACLC
+* ..
+* .. Executable Statements ..
+*
+ APPLYLEFT = LSAME( SIDE, 'L' )
+ LASTV = 0
+ LASTC = 0
+ IF( TAU.NE.ZERO ) THEN
+! Set up variables for scanning V. LASTV begins pointing to the end
+! of V.
+ IF( APPLYLEFT ) THEN
+ LASTV = M
+ ELSE
+ LASTV = N
+ END IF
+ IF( INCV.GT.0 ) THEN
+ I = 1 + (LASTV-1) * INCV
+ ELSE
+ I = 1
+ END IF
+! Look for the last non-zero row in V.
+ DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
+ LASTV = LASTV - 1
+ I = I - INCV
+ END DO
+ IF( APPLYLEFT ) THEN
+! Scan for the last non-zero column in C(1:lastv,:).
+ LASTC = ILACLC(LASTV, N, C, LDC)
+ ELSE
+! Scan for the last non-zero row in C(:,1:lastv).
+ LASTC = ILACLR(M, LASTV, C, LDC)
+ END IF
+ END IF
+! Note that lastc.eq.0 renders the BLAS operations null; no special
+! case is needed at this level.
+ IF( APPLYLEFT ) THEN
+*
+* Form H * C
+*
+ IF( LASTV.GT.0 ) THEN
+*
+* w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1)
+*
+ CALL CGEMV( 'Conjugate transpose', LASTV, LASTC, ONE,
+ $ C, LDC, V, INCV, ZERO, WORK, 1 )
+*
+* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H
+*
+ CALL CGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
+ END IF
+ ELSE
+*
+* Form C * H
+*
+ IF( LASTV.GT.0 ) THEN
+*
+* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
+*
+ CALL CGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
+ $ V, INCV, ZERO, WORK, 1 )
+*
+* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H
+*
+ CALL CGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
+ END IF
+ END IF
+ RETURN
+*
+* End of CLARF
+*
+ END
diff --git a/lapack/clarfb.f b/lapack/clarfb.f
new file mode 100644
index 0000000..40bbdf4
--- /dev/null
+++ b/lapack/clarfb.f
@@ -0,0 +1,771 @@
+*> \brief \b CLARFB
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLARFB + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarfb.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarfb.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarfb.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+* T, LDT, C, LDC, WORK, LDWORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, SIDE, STOREV, TRANS
+* INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+* COMPLEX C( LDC, * ), T( LDT, * ), V( LDV, * ),
+* $ WORK( LDWORK, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CLARFB applies a complex block reflector H or its transpose H**H to a
+*> complex M-by-N matrix C, from either the left or the right.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is CHARACTER*1
+*> = 'L': apply H or H**H from the Left
+*> = 'R': apply H or H**H from the Right
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*> TRANS is CHARACTER*1
+*> = 'N': apply H (No transpose)
+*> = 'C': apply H**H (Conjugate transpose)
+*> \endverbatim
+*>
+*> \param[in] DIRECT
+*> \verbatim
+*> DIRECT is CHARACTER*1
+*> Indicates how H is formed from a product of elementary
+*> reflectors
+*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*> STOREV is CHARACTER*1
+*> Indicates how the vectors which define the elementary
+*> reflectors are stored:
+*> = 'C': Columnwise
+*> = 'R': Rowwise
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> The order of the matrix T (= the number of elementary
+*> reflectors whose product defines the block reflector).
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is COMPLEX array, dimension
+*> (LDV,K) if STOREV = 'C'
+*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
+*> (LDV,N) if STOREV = 'R' and SIDE = 'R'
+*> The matrix V. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V.
+*> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+*> if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*> T is COMPLEX array, dimension (LDT,K)
+*> The triangular K-by-K matrix T in the representation of the
+*> block reflector.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*> LDT is INTEGER
+*> The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is COMPLEX array, dimension (LDC,N)
+*> On entry, the M-by-N matrix C.
+*> On exit, C is overwritten by H*C or H**H*C or C*H or C*H**H.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX array, dimension (LDWORK,K)
+*> \endverbatim
+*>
+*> \param[in] LDWORK
+*> \verbatim
+*> LDWORK is INTEGER
+*> The leading dimension of the array WORK.
+*> If SIDE = 'L', LDWORK >= max(1,N);
+*> if SIDE = 'R', LDWORK >= max(1,M).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complexOTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> The shape of the matrix V and the storage of the vectors which define
+*> the H(i) is best illustrated by the following example with n = 5 and
+*> k = 3. The elements equal to 1 are not stored; the corresponding
+*> array elements are modified but restored on exit. The rest of the
+*> array is not used.
+*>
+*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*>
+*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+*> ( v1 1 ) ( 1 v2 v2 v2 )
+*> ( v1 v2 1 ) ( 1 v3 v3 )
+*> ( v1 v2 v3 )
+*> ( v1 v2 v3 )
+*>
+*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*>
+*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
+*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+*> ( 1 v3 )
+*> ( 1 )
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+ $ T, LDT, C, LDC, WORK, LDWORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, SIDE, STOREV, TRANS
+ INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX C( LDC, * ), T( LDT, * ), V( LDV, * ),
+ $ WORK( LDWORK, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX ONE
+ PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
+* ..
+* .. Local Scalars ..
+ CHARACTER TRANST
+ INTEGER I, J, LASTV, LASTC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILACLR, ILACLC
+ EXTERNAL LSAME, ILACLR, ILACLC
+* ..
+* .. External Subroutines ..
+ EXTERNAL CCOPY, CGEMM, CLACGV, CTRMM
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CONJG
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( M.LE.0 .OR. N.LE.0 )
+ $ RETURN
+*
+ IF( LSAME( TRANS, 'N' ) ) THEN
+ TRANST = 'C'
+ ELSE
+ TRANST = 'N'
+ END IF
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 ) (first K rows)
+* ( V2 )
+* where V1 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILACLR( M, K, V, LDV ) )
+ LASTC = ILACLC( LASTV, N, C, LDC )
+*
+* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
+*
+* W := C1**H
+*
+ DO 10 J = 1, K
+ CALL CCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL CLACGV( LASTC, WORK( 1, J ), 1 )
+ 10 CONTINUE
+*
+* W := W * V1
+*
+ CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**H *V2
+*
+ CALL CGEMM( 'Conjugate transpose', 'No transpose',
+ $ LASTC, K, LASTV-K, ONE, C( K+1, 1 ), LDC,
+ $ V( K+1, 1 ), LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL CTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**H
+*
+ IF( M.GT.K ) THEN
+*
+* C2 := C2 - V2 * W**H
+*
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTV-K, LASTC, K, -ONE, V( K+1, 1 ), LDV,
+ $ WORK, LDWORK, ONE, C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1**H
+*
+ CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**H
+*
+ DO 30 J = 1, K
+ DO 20 I = 1, LASTC
+ C( J, I ) = C( J, I ) - CONJG( WORK( I, J ) )
+ 20 CONTINUE
+ 30 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILACLR( N, K, V, LDV ) )
+ LASTC = ILACLR( M, LASTV, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C1
+*
+ DO 40 J = 1, K
+ CALL CCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 40 CONTINUE
+*
+* W := W * V1
+*
+ CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2
+*
+ CALL CGEMM( 'No transpose', 'No transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL CTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - W * V2**H
+*
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, LASTV-K, K,
+ $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV,
+ $ ONE, C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1**H
+*
+ CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 60 J = 1, K
+ DO 50 I = 1, LASTC
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 )
+* ( V2 ) (last K rows)
+* where V2 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILACLR( M, K, V, LDV ) )
+ LASTC = ILACLC( LASTV, N, C, LDC )
+*
+* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
+*
+* W := C2**H
+*
+ DO 70 J = 1, K
+ CALL CCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ CALL CLACGV( LASTC, WORK( 1, J ), 1 )
+ 70 CONTINUE
+*
+* W := W * V2
+*
+ CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1**H*V1
+*
+ CALL CGEMM( 'Conjugate transpose', 'No transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - V1 * W**H
+*
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**H
+*
+ CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**H
+*
+ DO 90 J = 1, K
+ DO 80 I = 1, LASTC
+ C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
+ $ CONJG( WORK( I, J ) )
+ 80 CONTINUE
+ 90 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILACLR( N, K, V, LDV ) )
+ LASTC = ILACLR( M, LASTV, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C2
+*
+ DO 100 J = 1, K
+ CALL CCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ $ WORK( 1, J ), 1 )
+ 100 CONTINUE
+*
+* W := W * V2
+*
+ CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1 * V1
+*
+ CALL CGEMM( 'No transpose', 'No transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL CTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - W * V1**H
+*
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**H
+*
+ CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W
+*
+ DO 120 J = 1, K
+ DO 110 I = 1, LASTC
+ C( I, LASTV-K+J ) = C( I, LASTV-K+J )
+ $ - WORK( I, J )
+ 110 CONTINUE
+ 120 CONTINUE
+ END IF
+ END IF
+*
+ ELSE IF( LSAME( STOREV, 'R' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 V2 ) (V1: first K columns)
+* where V1 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILACLC( K, M, V, LDV ) )
+ LASTC = ILACLC( LASTV, N, C, LDC )
+*
+* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
+*
+* W := C1**H
+*
+ DO 130 J = 1, K
+ CALL CCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL CLACGV( LASTC, WORK( 1, J ), 1 )
+ 130 CONTINUE
+*
+* W := W * V1**H
+*
+ CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**H*V2**H
+*
+ CALL CGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTC, K, LASTV-K,
+ $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL CTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**H * W**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - V2**H * W**H
+*
+ CALL CGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTV-K, LASTC, K,
+ $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
+ $ ONE, C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**H
+*
+ DO 150 J = 1, K
+ DO 140 I = 1, LASTC
+ C( J, I ) = C( J, I ) - CONJG( WORK( I, J ) )
+ 140 CONTINUE
+ 150 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILACLC( K, N, V, LDV ) )
+ LASTC = ILACLR( M, LASTV, C, LDC )
+*
+* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
+*
+* W := C1
+*
+ DO 160 J = 1, K
+ CALL CCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 160 CONTINUE
+*
+* W := W * V1**H
+*
+ CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2**H
+*
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC,
+ $ V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL CTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - W * V2
+*
+ CALL CGEMM( 'No transpose', 'No transpose',
+ $ LASTC, LASTV-K, K,
+ $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
+ $ ONE, C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 180 J = 1, K
+ DO 170 I = 1, LASTC
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 170 CONTINUE
+ 180 CONTINUE
+*
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 V2 ) (V2: last K columns)
+* where V2 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILACLC( K, M, V, LDV ) )
+ LASTC = ILACLC( LASTV, N, C, LDC )
+*
+* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
+*
+* W := C2**H
+*
+ DO 190 J = 1, K
+ CALL CCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ CALL CLACGV( LASTC, WORK( 1, J ), 1 )
+ 190 CONTINUE
+*
+* W := W * V2**H
+*
+ CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1**H * V1**H
+*
+ CALL CGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTC, K, LASTV-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**H * W**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - V1**H * W**H
+*
+ CALL CGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTV-K, LASTC, K,
+ $ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**H
+*
+ DO 210 J = 1, K
+ DO 200 I = 1, LASTC
+ C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
+ $ CONJG( WORK( I, J ) )
+ 200 CONTINUE
+ 210 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILACLC( K, N, V, LDV ) )
+ LASTC = ILACLR( M, LASTV, C, LDC )
+*
+* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
+*
+* W := C2
+*
+ DO 220 J = 1, K
+ CALL CCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ $ WORK( 1, J ), 1 )
+ 220 CONTINUE
+*
+* W := W * V2**H
+*
+ CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1 * V1**H
+*
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
+ $ WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL CTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - W * V1
+*
+ CALL CGEMM( 'No transpose', 'No transpose',
+ $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 240 J = 1, K
+ DO 230 I = 1, LASTC
+ C( I, LASTV-K+J ) = C( I, LASTV-K+J )
+ $ - WORK( I, J )
+ 230 CONTINUE
+ 240 CONTINUE
+*
+ END IF
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of CLARFB
+*
+ END
diff --git a/lapack/clarfg.f b/lapack/clarfg.f
new file mode 100644
index 0000000..d64f396
--- /dev/null
+++ b/lapack/clarfg.f
@@ -0,0 +1,203 @@
+*> \brief \b CLARFG
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLARFG + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarfg.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarfg.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarfg.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )
+*
+* .. Scalar Arguments ..
+* INTEGER INCX, N
+* COMPLEX ALPHA, TAU
+* ..
+* .. Array Arguments ..
+* COMPLEX X( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CLARFG generates a complex elementary reflector H of order n, such
+*> that
+*>
+*> H**H * ( alpha ) = ( beta ), H**H * H = I.
+*> ( x ) ( 0 )
+*>
+*> where alpha and beta are scalars, with beta real, and x is an
+*> (n-1)-element complex vector. H is represented in the form
+*>
+*> H = I - tau * ( 1 ) * ( 1 v**H ) ,
+*> ( v )
+*>
+*> where tau is a complex scalar and v is a complex (n-1)-element
+*> vector. Note that H is not hermitian.
+*>
+*> If the elements of x are all zero and alpha is real, then tau = 0
+*> and H is taken to be the unit matrix.
+*>
+*> Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 .
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the elementary reflector.
+*> \endverbatim
+*>
+*> \param[in,out] ALPHA
+*> \verbatim
+*> ALPHA is COMPLEX
+*> On entry, the value alpha.
+*> On exit, it is overwritten with the value beta.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*> X is COMPLEX array, dimension
+*> (1+(N-2)*abs(INCX))
+*> On entry, the vector x.
+*> On exit, it is overwritten with the vector v.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> The increment between elements of X. INCX > 0.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX
+*> The value tau.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complexOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ COMPLEX ALPHA, TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX X( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER J, KNT
+ REAL ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
+* ..
+* .. External Functions ..
+ REAL SCNRM2, SLAMCH, SLAPY3
+ COMPLEX CLADIV
+ EXTERNAL SCNRM2, SLAMCH, SLAPY3, CLADIV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, AIMAG, CMPLX, REAL, SIGN
+* ..
+* .. External Subroutines ..
+ EXTERNAL CSCAL, CSSCAL
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.0 ) THEN
+ TAU = ZERO
+ RETURN
+ END IF
+*
+ XNORM = SCNRM2( N-1, X, INCX )
+ ALPHR = REAL( ALPHA )
+ ALPHI = AIMAG( ALPHA )
+*
+ IF( XNORM.EQ.ZERO .AND. ALPHI.EQ.ZERO ) THEN
+*
+* H = I
+*
+ TAU = ZERO
+ ELSE
+*
+* general case
+*
+ BETA = -SIGN( SLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ SAFMIN = SLAMCH( 'S' ) / SLAMCH( 'E' )
+ RSAFMN = ONE / SAFMIN
+*
+ KNT = 0
+ IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+* XNORM, BETA may be inaccurate; scale X and recompute them
+*
+ 10 CONTINUE
+ KNT = KNT + 1
+ CALL CSSCAL( N-1, RSAFMN, X, INCX )
+ BETA = BETA*RSAFMN
+ ALPHI = ALPHI*RSAFMN
+ ALPHR = ALPHR*RSAFMN
+ IF( ABS( BETA ).LT.SAFMIN )
+ $ GO TO 10
+*
+* New BETA is at most 1, at least SAFMIN
+*
+ XNORM = SCNRM2( N-1, X, INCX )
+ ALPHA = CMPLX( ALPHR, ALPHI )
+ BETA = -SIGN( SLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ END IF
+ TAU = CMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
+ ALPHA = CLADIV( CMPLX( ONE ), ALPHA-BETA )
+ CALL CSCAL( N-1, ALPHA, X, INCX )
+*
+* If ALPHA is subnormal, it may lose relative accuracy
+*
+ DO 20 J = 1, KNT
+ BETA = BETA*SAFMIN
+ 20 CONTINUE
+ ALPHA = BETA
+ END IF
+*
+ RETURN
+*
+* End of CLARFG
+*
+ END
diff --git a/lapack/clarft.f b/lapack/clarft.f
new file mode 100644
index 0000000..981447f
--- /dev/null
+++ b/lapack/clarft.f
@@ -0,0 +1,328 @@
+*> \brief \b CLARFT
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLARFT + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarft.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarft.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarft.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, STOREV
+* INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+* COMPLEX T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CLARFT forms the triangular factor T of a complex block reflector H
+*> of order n, which is defined as a product of k elementary reflectors.
+*>
+*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+*>
+*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+*>
+*> If STOREV = 'C', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th column of the array V, and
+*>
+*> H = I - V * T * V**H
+*>
+*> If STOREV = 'R', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th row of the array V, and
+*>
+*> H = I - V**H * T * V
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DIRECT
+*> \verbatim
+*> DIRECT is CHARACTER*1
+*> Specifies the order in which the elementary reflectors are
+*> multiplied to form the block reflector:
+*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*> STOREV is CHARACTER*1
+*> Specifies how the vectors which define the elementary
+*> reflectors are stored (see also Further Details):
+*> = 'C': columnwise
+*> = 'R': rowwise
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the block reflector H. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> The order of the triangular factor T (= the number of
+*> elementary reflectors). K >= 1.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is COMPLEX array, dimension
+*> (LDV,K) if STOREV = 'C'
+*> (LDV,N) if STOREV = 'R'
+*> The matrix V. See further details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V.
+*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*> TAU is COMPLEX array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*> T is COMPLEX array, dimension (LDT,K)
+*> The k by k triangular factor T of the block reflector.
+*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+*> lower triangular. The rest of the array is not used.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*> LDT is INTEGER
+*> The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date April 2012
+*
+*> \ingroup complexOTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> The shape of the matrix V and the storage of the vectors which define
+*> the H(i) is best illustrated by the following example with n = 5 and
+*> k = 3. The elements equal to 1 are not stored.
+*>
+*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*>
+*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+*> ( v1 1 ) ( 1 v2 v2 v2 )
+*> ( v1 v2 1 ) ( 1 v3 v3 )
+*> ( v1 v2 v3 )
+*> ( v1 v2 v3 )
+*>
+*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*>
+*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
+*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+*> ( 1 v3 )
+*> ( 1 )
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* -- LAPACK auxiliary routine (version 3.4.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* April 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, STOREV
+ INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+ COMPLEX T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX ONE, ZERO
+ PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ),
+ $ ZERO = ( 0.0E+0, 0.0E+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J, PREVLASTV, LASTV
+* ..
+* .. External Subroutines ..
+ EXTERNAL CGEMV, CLACGV, CTRMV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+ PREVLASTV = N
+ DO I = 1, K
+ PREVLASTV = MAX( PREVLASTV, I )
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO J = 1, I
+ T( J, I ) = ZERO
+ END DO
+ ELSE
+*
+* general case
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+* Skip any trailing zeros.
+ DO LASTV = N, I+1, -1
+ IF( V( LASTV, I ).NE.ZERO ) EXIT
+ END DO
+ DO J = 1, I-1
+ T( J, I ) = -TAU( I ) * CONJG( V( I , J ) )
+ END DO
+ J = MIN( LASTV, PREVLASTV )
+*
+* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**H * V(i:j,i)
+*
+ CALL CGEMV( 'Conjugate transpose', J-I, I-1,
+ $ -TAU( I ), V( I+1, 1 ), LDV,
+ $ V( I+1, I ), 1,
+ $ ONE, T( 1, I ), 1 )
+ ELSE
+* Skip any trailing zeros.
+ DO LASTV = N, I+1, -1
+ IF( V( I, LASTV ).NE.ZERO ) EXIT
+ END DO
+ DO J = 1, I-1
+ T( J, I ) = -TAU( I ) * V( J , I )
+ END DO
+ J = MIN( LASTV, PREVLASTV )
+*
+* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**H
+*
+ CALL CGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ),
+ $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV,
+ $ ONE, T( 1, I ), LDT )
+ END IF
+*
+* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
+*
+ CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
+ $ LDT, T( 1, I ), 1 )
+ T( I, I ) = TAU( I )
+ IF( I.GT.1 ) THEN
+ PREVLASTV = MAX( PREVLASTV, LASTV )
+ ELSE
+ PREVLASTV = LASTV
+ END IF
+ END IF
+ END DO
+ ELSE
+ PREVLASTV = 1
+ DO I = K, 1, -1
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO J = I, K
+ T( J, I ) = ZERO
+ END DO
+ ELSE
+*
+* general case
+*
+ IF( I.LT.K ) THEN
+ IF( LSAME( STOREV, 'C' ) ) THEN
+* Skip any leading zeros.
+ DO LASTV = 1, I-1
+ IF( V( LASTV, I ).NE.ZERO ) EXIT
+ END DO
+ DO J = I+1, K
+ T( J, I ) = -TAU( I ) * CONJG( V( N-K+I , J ) )
+ END DO
+ J = MAX( LASTV, PREVLASTV )
+*
+* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**H * V(j:n-k+i,i)
+*
+ CALL CGEMV( 'Conjugate transpose', N-K+I-J, K-I,
+ $ -TAU( I ), V( J, I+1 ), LDV, V( J, I ),
+ $ 1, ONE, T( I+1, I ), 1 )
+ ELSE
+* Skip any leading zeros.
+ DO LASTV = 1, I-1
+ IF( V( I, LASTV ).NE.ZERO ) EXIT
+ END DO
+ DO J = I+1, K
+ T( J, I ) = -TAU( I ) * V( J, N-K+I )
+ END DO
+ J = MAX( LASTV, PREVLASTV )
+*
+* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H
+*
+ CALL CGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ),
+ $ V( I+1, J ), LDV, V( I, J ), LDV,
+ $ ONE, T( I+1, I ), LDT )
+ END IF
+*
+* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
+*
+ CALL CTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
+ $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
+ IF( I.GT.1 ) THEN
+ PREVLASTV = MIN( PREVLASTV, LASTV )
+ ELSE
+ PREVLASTV = LASTV
+ END IF
+ END IF
+ T( I, I ) = TAU( I )
+ END IF
+ END DO
+ END IF
+ RETURN
+*
+* End of CLARFT
+*
+ END
diff --git a/lapack/dladiv.f b/lapack/dladiv.f
new file mode 100644
index 0000000..090a906
--- /dev/null
+++ b/lapack/dladiv.f
@@ -0,0 +1,128 @@
+*> \brief \b DLADIV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLADIV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dladiv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dladiv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dladiv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DLADIV( A, B, C, D, P, Q )
+*
+* .. Scalar Arguments ..
+* DOUBLE PRECISION A, B, C, D, P, Q
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLADIV performs complex division in real arithmetic
+*>
+*> a + i*b
+*> p + i*q = ---------
+*> c + i*d
+*>
+*> The algorithm is due to Robert L. Smith and can be found
+*> in D. Knuth, The art of Computer Programming, Vol.2, p.195
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] A
+*> \verbatim
+*> A is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*> B is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] C
+*> \verbatim
+*> C is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] D
+*> \verbatim
+*> D is DOUBLE PRECISION
+*> The scalars a, b, c, and d in the above expression.
+*> \endverbatim
+*>
+*> \param[out] P
+*> \verbatim
+*> P is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[out] Q
+*> \verbatim
+*> Q is DOUBLE PRECISION
+*> The scalars p and q in the above expression.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE DLADIV( A, B, C, D, P, Q )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION A, B, C, D, P, Q
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ DOUBLE PRECISION E, F
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS
+* ..
+* .. Executable Statements ..
+*
+ IF( ABS( D ).LT.ABS( C ) ) THEN
+ E = D / C
+ F = C + D*E
+ P = ( A+B*E ) / F
+ Q = ( B-A*E ) / F
+ ELSE
+ E = C / D
+ F = D + C*E
+ P = ( B+A*E ) / F
+ Q = ( -A+B*E ) / F
+ END IF
+*
+ RETURN
+*
+* End of DLADIV
+*
+ END
diff --git a/lapack/dlamch.f b/lapack/dlamch.f
new file mode 100644
index 0000000..eb307e5
--- /dev/null
+++ b/lapack/dlamch.f
@@ -0,0 +1,189 @@
+*> \brief \b DLAMCH
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLAMCH determines double precision machine parameters.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] CMACH
+*> \verbatim
+*> Specifies the value to be returned by DLAMCH:
+*> = 'E' or 'e', DLAMCH := eps
+*> = 'S' or 's , DLAMCH := sfmin
+*> = 'B' or 'b', DLAMCH := base
+*> = 'P' or 'p', DLAMCH := eps*base
+*> = 'N' or 'n', DLAMCH := t
+*> = 'R' or 'r', DLAMCH := rnd
+*> = 'M' or 'm', DLAMCH := emin
+*> = 'U' or 'u', DLAMCH := rmin
+*> = 'L' or 'l', DLAMCH := emax
+*> = 'O' or 'o', DLAMCH := rmax
+*> where
+*> eps = relative machine precision
+*> sfmin = safe minimum, such that 1/sfmin does not overflow
+*> base = base of the machine
+*> prec = eps*base
+*> t = number of (base) digits in the mantissa
+*> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+*> emin = minimum exponent before (gradual) underflow
+*> rmin = underflow threshold - base**(emin-1)
+*> emax = largest exponent before overflow
+*> rmax = overflow threshold - (base**emax)*(1-eps)
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER CMACH
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
+ $ MINEXPONENT, RADIX, TINY
+* ..
+* .. Executable Statements ..
+*
+*
+* Assume rounding, not chopping. Always.
+*
+ RND = ONE
+*
+ IF( ONE.EQ.RND ) THEN
+ EPS = EPSILON(ZERO) * 0.5
+ ELSE
+ EPS = EPSILON(ZERO)
+ END IF
+*
+ IF( LSAME( CMACH, 'E' ) ) THEN
+ RMACH = EPS
+ ELSE IF( LSAME( CMACH, 'S' ) ) THEN
+ SFMIN = TINY(ZERO)
+ SMALL = ONE / HUGE(ZERO)
+ IF( SMALL.GE.SFMIN ) THEN
+*
+* Use SMALL plus a bit, to avoid the possibility of rounding
+* causing overflow when computing 1/sfmin.
+*
+ SFMIN = SMALL*( ONE+EPS )
+ END IF
+ RMACH = SFMIN
+ ELSE IF( LSAME( CMACH, 'B' ) ) THEN
+ RMACH = RADIX(ZERO)
+ ELSE IF( LSAME( CMACH, 'P' ) ) THEN
+ RMACH = EPS * RADIX(ZERO)
+ ELSE IF( LSAME( CMACH, 'N' ) ) THEN
+ RMACH = DIGITS(ZERO)
+ ELSE IF( LSAME( CMACH, 'R' ) ) THEN
+ RMACH = RND
+ ELSE IF( LSAME( CMACH, 'M' ) ) THEN
+ RMACH = MINEXPONENT(ZERO)
+ ELSE IF( LSAME( CMACH, 'U' ) ) THEN
+ RMACH = tiny(zero)
+ ELSE IF( LSAME( CMACH, 'L' ) ) THEN
+ RMACH = MAXEXPONENT(ZERO)
+ ELSE IF( LSAME( CMACH, 'O' ) ) THEN
+ RMACH = HUGE(ZERO)
+ ELSE
+ RMACH = ZERO
+ END IF
+*
+ DLAMCH = RMACH
+ RETURN
+*
+* End of DLAMCH
+*
+ END
+************************************************************************
+*> \brief \b DLAMC3
+*> \details
+*> \b Purpose:
+*> \verbatim
+*> DLAMC3 is intended to force A and B to be stored prior to doing
+*> the addition of A and B , for use in situations where optimizers
+*> might hold one of these in a register.
+*> \endverbatim
+*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
+*> \date November 2011
+*> \ingroup auxOTHERauxiliary
+*>
+*> \param[in] A
+*> \verbatim
+*> A is a DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*> B is a DOUBLE PRECISION
+*> The values A and B.
+*> \endverbatim
+*>
+ DOUBLE PRECISION FUNCTION DLAMC3( A, B )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+* November 2010
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION A, B
+* ..
+* =====================================================================
+*
+* .. Executable Statements ..
+*
+ DLAMC3 = A + B
+*
+ RETURN
+*
+* End of DLAMC3
+*
+ END
+*
+************************************************************************
diff --git a/lapack/dlapy2.f b/lapack/dlapy2.f
new file mode 100644
index 0000000..e6a62bf
--- /dev/null
+++ b/lapack/dlapy2.f
@@ -0,0 +1,104 @@
+*> \brief \b DLAPY2
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLAPY2 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy2.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy2.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy2.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
+*
+* .. Scalar Arguments ..
+* DOUBLE PRECISION X, Y
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+*> overflow.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] X
+*> \verbatim
+*> X is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*> Y is DOUBLE PRECISION
+*> X and Y specify the values x and y.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION X, Y
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D0 )
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION W, XABS, YABS, Z
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ W = MAX( XABS, YABS )
+ Z = MIN( XABS, YABS )
+ IF( Z.EQ.ZERO ) THEN
+ DLAPY2 = W
+ ELSE
+ DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
+ END IF
+ RETURN
+*
+* End of DLAPY2
+*
+ END
diff --git a/lapack/dlapy3.f b/lapack/dlapy3.f
new file mode 100644
index 0000000..ae9844f
--- /dev/null
+++ b/lapack/dlapy3.f
@@ -0,0 +1,111 @@
+*> \brief \b DLAPY3
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLAPY3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
+*
+* .. Scalar Arguments ..
+* DOUBLE PRECISION X, Y, Z
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
+*> unnecessary overflow.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] X
+*> \verbatim
+*> X is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*> Y is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] Z
+*> \verbatim
+*> Z is DOUBLE PRECISION
+*> X, Y and Z specify the values x, y and z.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION X, Y, Z
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION W, XABS, YABS, ZABS
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, SQRT
+* ..
+* .. Executable Statements ..
+*
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ ZABS = ABS( Z )
+ W = MAX( XABS, YABS, ZABS )
+ IF( W.EQ.ZERO ) THEN
+* W can be zero for max(0,nan,0)
+* adding all three entries together will make sure
+* NaN will not disappear.
+ DLAPY3 = XABS + YABS + ZABS
+ ELSE
+ DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
+ $ ( ZABS / W )**2 )
+ END IF
+ RETURN
+*
+* End of DLAPY3
+*
+ END
diff --git a/lapack/dlarf.f b/lapack/dlarf.f
new file mode 100644
index 0000000..2a82ff4
--- /dev/null
+++ b/lapack/dlarf.f
@@ -0,0 +1,227 @@
+*> \brief \b DLARF
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLARF + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarf.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarf.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarf.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER SIDE
+* INTEGER INCV, LDC, M, N
+* DOUBLE PRECISION TAU
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLARF applies a real elementary reflector H to a real m by n matrix
+*> C, from either the left or the right. H is represented in the form
+*>
+*> H = I - tau * v * v**T
+*>
+*> where tau is a real scalar and v is a real vector.
+*>
+*> If tau = 0, then H is taken to be the unit matrix.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is CHARACTER*1
+*> = 'L': form H * C
+*> = 'R': form C * H
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is DOUBLE PRECISION array, dimension
+*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+*> The vector v in the representation of H. V is not used if
+*> TAU = 0.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*> INCV is INTEGER
+*> The increment between elements of v. INCV <> 0.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*> TAU is DOUBLE PRECISION
+*> The value tau in the representation of H.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is DOUBLE PRECISION array, dimension (LDC,N)
+*> On entry, the m by n matrix C.
+*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+*> or C * H if SIDE = 'R'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION array, dimension
+*> (N) if SIDE = 'L'
+*> or (M) if SIDE = 'R'
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup doubleOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE
+ INTEGER INCV, LDC, M, N
+ DOUBLE PRECISION TAU
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL APPLYLEFT
+ INTEGER I, LASTV, LASTC
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGEMV, DGER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILADLR, ILADLC
+ EXTERNAL LSAME, ILADLR, ILADLC
+* ..
+* .. Executable Statements ..
+*
+ APPLYLEFT = LSAME( SIDE, 'L' )
+ LASTV = 0
+ LASTC = 0
+ IF( TAU.NE.ZERO ) THEN
+! Set up variables for scanning V. LASTV begins pointing to the end
+! of V.
+ IF( APPLYLEFT ) THEN
+ LASTV = M
+ ELSE
+ LASTV = N
+ END IF
+ IF( INCV.GT.0 ) THEN
+ I = 1 + (LASTV-1) * INCV
+ ELSE
+ I = 1
+ END IF
+! Look for the last non-zero row in V.
+ DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
+ LASTV = LASTV - 1
+ I = I - INCV
+ END DO
+ IF( APPLYLEFT ) THEN
+! Scan for the last non-zero column in C(1:lastv,:).
+ LASTC = ILADLC(LASTV, N, C, LDC)
+ ELSE
+! Scan for the last non-zero row in C(:,1:lastv).
+ LASTC = ILADLR(M, LASTV, C, LDC)
+ END IF
+ END IF
+! Note that lastc.eq.0 renders the BLAS operations null; no special
+! case is needed at this level.
+ IF( APPLYLEFT ) THEN
+*
+* Form H * C
+*
+ IF( LASTV.GT.0 ) THEN
+*
+* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
+*
+ CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
+ $ ZERO, WORK, 1 )
+*
+* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
+*
+ CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
+ END IF
+ ELSE
+*
+* Form C * H
+*
+ IF( LASTV.GT.0 ) THEN
+*
+* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
+*
+ CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
+ $ V, INCV, ZERO, WORK, 1 )
+*
+* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
+*
+ CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
+ END IF
+ END IF
+ RETURN
+*
+* End of DLARF
+*
+ END
diff --git a/lapack/dlarfb.f b/lapack/dlarfb.f
new file mode 100644
index 0000000..206d3b2
--- /dev/null
+++ b/lapack/dlarfb.f
@@ -0,0 +1,762 @@
+*> \brief \b DLARFB
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLARFB + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfb.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfb.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfb.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+* T, LDT, C, LDC, WORK, LDWORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, SIDE, STOREV, TRANS
+* INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ),
+* $ WORK( LDWORK, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLARFB applies a real block reflector H or its transpose H**T to a
+*> real m by n matrix C, from either the left or the right.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is CHARACTER*1
+*> = 'L': apply H or H**T from the Left
+*> = 'R': apply H or H**T from the Right
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*> TRANS is CHARACTER*1
+*> = 'N': apply H (No transpose)
+*> = 'T': apply H**T (Transpose)
+*> \endverbatim
+*>
+*> \param[in] DIRECT
+*> \verbatim
+*> DIRECT is CHARACTER*1
+*> Indicates how H is formed from a product of elementary
+*> reflectors
+*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*> STOREV is CHARACTER*1
+*> Indicates how the vectors which define the elementary
+*> reflectors are stored:
+*> = 'C': Columnwise
+*> = 'R': Rowwise
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> The order of the matrix T (= the number of elementary
+*> reflectors whose product defines the block reflector).
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is DOUBLE PRECISION array, dimension
+*> (LDV,K) if STOREV = 'C'
+*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
+*> (LDV,N) if STOREV = 'R' and SIDE = 'R'
+*> The matrix V. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V.
+*> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+*> if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*> T is DOUBLE PRECISION array, dimension (LDT,K)
+*> The triangular k by k matrix T in the representation of the
+*> block reflector.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*> LDT is INTEGER
+*> The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is DOUBLE PRECISION array, dimension (LDC,N)
+*> On entry, the m by n matrix C.
+*> On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION array, dimension (LDWORK,K)
+*> \endverbatim
+*>
+*> \param[in] LDWORK
+*> \verbatim
+*> LDWORK is INTEGER
+*> The leading dimension of the array WORK.
+*> If SIDE = 'L', LDWORK >= max(1,N);
+*> if SIDE = 'R', LDWORK >= max(1,M).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup doubleOTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> The shape of the matrix V and the storage of the vectors which define
+*> the H(i) is best illustrated by the following example with n = 5 and
+*> k = 3. The elements equal to 1 are not stored; the corresponding
+*> array elements are modified but restored on exit. The rest of the
+*> array is not used.
+*>
+*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*>
+*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+*> ( v1 1 ) ( 1 v2 v2 v2 )
+*> ( v1 v2 1 ) ( 1 v3 v3 )
+*> ( v1 v2 v3 )
+*> ( v1 v2 v3 )
+*>
+*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*>
+*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
+*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+*> ( 1 v3 )
+*> ( 1 )
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+ $ T, LDT, C, LDC, WORK, LDWORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, SIDE, STOREV, TRANS
+ INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ),
+ $ WORK( LDWORK, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ CHARACTER TRANST
+ INTEGER I, J, LASTV, LASTC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILADLR, ILADLC
+ EXTERNAL LSAME, ILADLR, ILADLC
+* ..
+* .. External Subroutines ..
+ EXTERNAL DCOPY, DGEMM, DTRMM
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( M.LE.0 .OR. N.LE.0 )
+ $ RETURN
+*
+ IF( LSAME( TRANS, 'N' ) ) THEN
+ TRANST = 'T'
+ ELSE
+ TRANST = 'N'
+ END IF
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 ) (first K rows)
+* ( V2 )
+* where V1 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**T * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILADLR( M, K, V, LDV ) )
+ LASTC = ILADLC( LASTV, N, C, LDC )
+*
+* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
+*
+* W := C1**T
+*
+ DO 10 J = 1, K
+ CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ 10 CONTINUE
+*
+* W := W * V1
+*
+ CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**T *V2
+*
+ CALL DGEMM( 'Transpose', 'No transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**T or W * T
+*
+ CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - V2 * W**T
+*
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ LASTV-K, LASTC, K,
+ $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
+ $ C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1**T
+*
+ CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**T
+*
+ DO 30 J = 1, K
+ DO 20 I = 1, LASTC
+ C( J, I ) = C( J, I ) - WORK( I, J )
+ 20 CONTINUE
+ 30 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**T where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILADLR( N, K, V, LDV ) )
+ LASTC = ILADLR( M, LASTV, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C1
+*
+ DO 40 J = 1, K
+ CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 40 CONTINUE
+*
+* W := W * V1
+*
+ CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2
+*
+ CALL DGEMM( 'No transpose', 'No transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**T
+*
+ CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - W * V2**T
+*
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ LASTC, LASTV-K, K,
+ $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
+ $ C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1**T
+*
+ CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 60 J = 1, K
+ DO 50 I = 1, LASTC
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 )
+* ( V2 ) (last K rows)
+* where V2 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**T * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILADLR( M, K, V, LDV ) )
+ LASTC = ILADLC( LASTV, N, C, LDC )
+*
+* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
+*
+* W := C2**T
+*
+ DO 70 J = 1, K
+ CALL DCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ 70 CONTINUE
+*
+* W := W * V2
+*
+ CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1**T*V1
+*
+ CALL DGEMM( 'Transpose', 'No transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**T or W * T
+*
+ CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - V1 * W**T
+*
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**T
+*
+ CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**T
+*
+ DO 90 J = 1, K
+ DO 80 I = 1, LASTC
+ C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+ 80 CONTINUE
+ 90 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**T where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILADLR( N, K, V, LDV ) )
+ LASTC = ILADLR( M, LASTV, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C2
+*
+ DO 100 J = 1, K
+ CALL DCOPY( LASTC, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
+ 100 CONTINUE
+*
+* W := W * V2
+*
+ CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1 * V1
+*
+ CALL DGEMM( 'No transpose', 'No transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**T
+*
+ CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - W * V1**T
+*
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**T
+*
+ CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W
+*
+ DO 120 J = 1, K
+ DO 110 I = 1, LASTC
+ C( I, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J)
+ 110 CONTINUE
+ 120 CONTINUE
+ END IF
+ END IF
+*
+ ELSE IF( LSAME( STOREV, 'R' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 V2 ) (V1: first K columns)
+* where V1 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**T * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILADLC( K, M, V, LDV ) )
+ LASTC = ILADLC( LASTV, N, C, LDC )
+*
+* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
+*
+* W := C1**T
+*
+ DO 130 J = 1, K
+ CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ 130 CONTINUE
+*
+* W := W * V1**T
+*
+ CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**T*V2**T
+*
+ CALL DGEMM( 'Transpose', 'Transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**T or W * T
+*
+ CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**T * W**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - V2**T * W**T
+*
+ CALL DGEMM( 'Transpose', 'Transpose',
+ $ LASTV-K, LASTC, K,
+ $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
+ $ ONE, C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**T
+*
+ DO 150 J = 1, K
+ DO 140 I = 1, LASTC
+ C( J, I ) = C( J, I ) - WORK( I, J )
+ 140 CONTINUE
+ 150 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**T where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILADLC( K, N, V, LDV ) )
+ LASTC = ILADLR( M, LASTV, C, LDC )
+*
+* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
+*
+* W := C1
+*
+ DO 160 J = 1, K
+ CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 160 CONTINUE
+*
+* W := W * V1**T
+*
+ CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2**T
+*
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**T
+*
+ CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - W * V2
+*
+ CALL DGEMM( 'No transpose', 'No transpose',
+ $ LASTC, LASTV-K, K,
+ $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
+ $ ONE, C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 180 J = 1, K
+ DO 170 I = 1, LASTC
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 170 CONTINUE
+ 180 CONTINUE
+*
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 V2 ) (V2: last K columns)
+* where V2 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**T * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILADLC( K, M, V, LDV ) )
+ LASTC = ILADLC( LASTV, N, C, LDC )
+*
+* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
+*
+* W := C2**T
+*
+ DO 190 J = 1, K
+ CALL DCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ 190 CONTINUE
+*
+* W := W * V2**T
+*
+ CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1**T * V1**T
+*
+ CALL DGEMM( 'Transpose', 'Transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**T or W * T
+*
+ CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**T * W**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - V1**T * W**T
+*
+ CALL DGEMM( 'Transpose', 'Transpose',
+ $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**T
+*
+ DO 210 J = 1, K
+ DO 200 I = 1, LASTC
+ C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+ 200 CONTINUE
+ 210 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**T where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILADLC( K, N, V, LDV ) )
+ LASTC = ILADLR( M, LASTV, C, LDC )
+*
+* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
+*
+* W := C2
+*
+ DO 220 J = 1, K
+ CALL DCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ $ WORK( 1, J ), 1 )
+ 220 CONTINUE
+*
+* W := W * V2**T
+*
+ CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1 * V1**T
+*
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**T
+*
+ CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - W * V1
+*
+ CALL DGEMM( 'No transpose', 'No transpose',
+ $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 240 J = 1, K
+ DO 230 I = 1, LASTC
+ C( I, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J)
+ 230 CONTINUE
+ 240 CONTINUE
+*
+ END IF
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of DLARFB
+*
+ END
diff --git a/lapack/dlarfg.f b/lapack/dlarfg.f
new file mode 100644
index 0000000..458ad2e
--- /dev/null
+++ b/lapack/dlarfg.f
@@ -0,0 +1,196 @@
+*> \brief \b DLARFG
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLARFG + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfg.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfg.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfg.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
+*
+* .. Scalar Arguments ..
+* INTEGER INCX, N
+* DOUBLE PRECISION ALPHA, TAU
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION X( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLARFG generates a real elementary reflector H of order n, such
+*> that
+*>
+*> H * ( alpha ) = ( beta ), H**T * H = I.
+*> ( x ) ( 0 )
+*>
+*> where alpha and beta are scalars, and x is an (n-1)-element real
+*> vector. H is represented in the form
+*>
+*> H = I - tau * ( 1 ) * ( 1 v**T ) ,
+*> ( v )
+*>
+*> where tau is a real scalar and v is a real (n-1)-element
+*> vector.
+*>
+*> If the elements of x are all zero, then tau = 0 and H is taken to be
+*> the unit matrix.
+*>
+*> Otherwise 1 <= tau <= 2.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the elementary reflector.
+*> \endverbatim
+*>
+*> \param[in,out] ALPHA
+*> \verbatim
+*> ALPHA is DOUBLE PRECISION
+*> On entry, the value alpha.
+*> On exit, it is overwritten with the value beta.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*> X is DOUBLE PRECISION array, dimension
+*> (1+(N-2)*abs(INCX))
+*> On entry, the vector x.
+*> On exit, it is overwritten with the vector v.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> The increment between elements of X. INCX > 0.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is DOUBLE PRECISION
+*> The value tau.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup doubleOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ DOUBLE PRECISION ALPHA, TAU
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION X( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER J, KNT
+ DOUBLE PRECISION BETA, RSAFMN, SAFMIN, XNORM
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH, DLAPY2, DNRM2
+ EXTERNAL DLAMCH, DLAPY2, DNRM2
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, SIGN
+* ..
+* .. External Subroutines ..
+ EXTERNAL DSCAL
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.1 ) THEN
+ TAU = ZERO
+ RETURN
+ END IF
+*
+ XNORM = DNRM2( N-1, X, INCX )
+*
+ IF( XNORM.EQ.ZERO ) THEN
+*
+* H = I
+*
+ TAU = ZERO
+ ELSE
+*
+* general case
+*
+ BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
+ SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
+ KNT = 0
+ IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+* XNORM, BETA may be inaccurate; scale X and recompute them
+*
+ RSAFMN = ONE / SAFMIN
+ 10 CONTINUE
+ KNT = KNT + 1
+ CALL DSCAL( N-1, RSAFMN, X, INCX )
+ BETA = BETA*RSAFMN
+ ALPHA = ALPHA*RSAFMN
+ IF( ABS( BETA ).LT.SAFMIN )
+ $ GO TO 10
+*
+* New BETA is at most 1, at least SAFMIN
+*
+ XNORM = DNRM2( N-1, X, INCX )
+ BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
+ END IF
+ TAU = ( BETA-ALPHA ) / BETA
+ CALL DSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
+*
+* If ALPHA is subnormal, it may lose relative accuracy
+*
+ DO 20 J = 1, KNT
+ BETA = BETA*SAFMIN
+ 20 CONTINUE
+ ALPHA = BETA
+ END IF
+*
+ RETURN
+*
+* End of DLARFG
+*
+ END
diff --git a/lapack/dlarft.f b/lapack/dlarft.f
new file mode 100644
index 0000000..4b75504
--- /dev/null
+++ b/lapack/dlarft.f
@@ -0,0 +1,326 @@
+*> \brief \b DLARFT
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLARFT + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarft.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarft.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarft.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, STOREV
+* INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLARFT forms the triangular factor T of a real block reflector H
+*> of order n, which is defined as a product of k elementary reflectors.
+*>
+*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+*>
+*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+*>
+*> If STOREV = 'C', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th column of the array V, and
+*>
+*> H = I - V * T * V**T
+*>
+*> If STOREV = 'R', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th row of the array V, and
+*>
+*> H = I - V**T * T * V
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DIRECT
+*> \verbatim
+*> DIRECT is CHARACTER*1
+*> Specifies the order in which the elementary reflectors are
+*> multiplied to form the block reflector:
+*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*> STOREV is CHARACTER*1
+*> Specifies how the vectors which define the elementary
+*> reflectors are stored (see also Further Details):
+*> = 'C': columnwise
+*> = 'R': rowwise
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the block reflector H. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> The order of the triangular factor T (= the number of
+*> elementary reflectors). K >= 1.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is DOUBLE PRECISION array, dimension
+*> (LDV,K) if STOREV = 'C'
+*> (LDV,N) if STOREV = 'R'
+*> The matrix V. See further details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V.
+*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*> TAU is DOUBLE PRECISION array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*> T is DOUBLE PRECISION array, dimension (LDT,K)
+*> The k by k triangular factor T of the block reflector.
+*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+*> lower triangular. The rest of the array is not used.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*> LDT is INTEGER
+*> The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date April 2012
+*
+*> \ingroup doubleOTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> The shape of the matrix V and the storage of the vectors which define
+*> the H(i) is best illustrated by the following example with n = 5 and
+*> k = 3. The elements equal to 1 are not stored.
+*>
+*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*>
+*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+*> ( v1 1 ) ( 1 v2 v2 v2 )
+*> ( v1 v2 1 ) ( 1 v3 v3 )
+*> ( v1 v2 v3 )
+*> ( v1 v2 v3 )
+*>
+*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*>
+*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
+*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+*> ( 1 v3 )
+*> ( 1 )
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* -- LAPACK auxiliary routine (version 3.4.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* April 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, STOREV
+ INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J, PREVLASTV, LASTV
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGEMV, DTRMV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+ PREVLASTV = N
+ DO I = 1, K
+ PREVLASTV = MAX( I, PREVLASTV )
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO J = 1, I
+ T( J, I ) = ZERO
+ END DO
+ ELSE
+*
+* general case
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+* Skip any trailing zeros.
+ DO LASTV = N, I+1, -1
+ IF( V( LASTV, I ).NE.ZERO ) EXIT
+ END DO
+ DO J = 1, I-1
+ T( J, I ) = -TAU( I ) * V( I , J )
+ END DO
+ J = MIN( LASTV, PREVLASTV )
+*
+* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i)
+*
+ CALL DGEMV( 'Transpose', J-I, I-1, -TAU( I ),
+ $ V( I+1, 1 ), LDV, V( I+1, I ), 1, ONE,
+ $ T( 1, I ), 1 )
+ ELSE
+* Skip any trailing zeros.
+ DO LASTV = N, I+1, -1
+ IF( V( I, LASTV ).NE.ZERO ) EXIT
+ END DO
+ DO J = 1, I-1
+ T( J, I ) = -TAU( I ) * V( J , I )
+ END DO
+ J = MIN( LASTV, PREVLASTV )
+*
+* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T
+*
+ CALL DGEMV( 'No transpose', I-1, J-I, -TAU( I ),
+ $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, ONE,
+ $ T( 1, I ), 1 )
+ END IF
+*
+* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
+*
+ CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
+ $ LDT, T( 1, I ), 1 )
+ T( I, I ) = TAU( I )
+ IF( I.GT.1 ) THEN
+ PREVLASTV = MAX( PREVLASTV, LASTV )
+ ELSE
+ PREVLASTV = LASTV
+ END IF
+ END IF
+ END DO
+ ELSE
+ PREVLASTV = 1
+ DO I = K, 1, -1
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO J = I, K
+ T( J, I ) = ZERO
+ END DO
+ ELSE
+*
+* general case
+*
+ IF( I.LT.K ) THEN
+ IF( LSAME( STOREV, 'C' ) ) THEN
+* Skip any leading zeros.
+ DO LASTV = 1, I-1
+ IF( V( LASTV, I ).NE.ZERO ) EXIT
+ END DO
+ DO J = I+1, K
+ T( J, I ) = -TAU( I ) * V( N-K+I , J )
+ END DO
+ J = MAX( LASTV, PREVLASTV )
+*
+* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i)
+*
+ CALL DGEMV( 'Transpose', N-K+I-J, K-I, -TAU( I ),
+ $ V( J, I+1 ), LDV, V( J, I ), 1, ONE,
+ $ T( I+1, I ), 1 )
+ ELSE
+* Skip any leading zeros.
+ DO LASTV = 1, I-1
+ IF( V( I, LASTV ).NE.ZERO ) EXIT
+ END DO
+ DO J = I+1, K
+ T( J, I ) = -TAU( I ) * V( J, N-K+I )
+ END DO
+ J = MAX( LASTV, PREVLASTV )
+*
+* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T
+*
+ CALL DGEMV( 'No transpose', K-I, N-K+I-J,
+ $ -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV,
+ $ ONE, T( I+1, I ), 1 )
+ END IF
+*
+* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
+*
+ CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
+ $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
+ IF( I.GT.1 ) THEN
+ PREVLASTV = MIN( PREVLASTV, LASTV )
+ ELSE
+ PREVLASTV = LASTV
+ END IF
+ END IF
+ T( I, I ) = TAU( I )
+ END IF
+ END DO
+ END IF
+ RETURN
+*
+* End of DLARFT
+*
+ END
diff --git a/lapack/dsecnd_NONE.f b/lapack/dsecnd_NONE.f
new file mode 100644
index 0000000..61a8dff
--- /dev/null
+++ b/lapack/dsecnd_NONE.f
@@ -0,0 +1,52 @@
+*> \brief \b DSECND returns nothing
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* DOUBLE PRECISION FUNCTION DSECND( )
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DSECND returns nothing instead of returning the user time for a process in seconds.
+*> If you are using that routine, it means that neither EXTERNAL ETIME,
+*> EXTERNAL ETIME_, INTERNAL ETIME, INTERNAL CPU_TIME is available on
+*> your machine.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ DOUBLE PRECISION FUNCTION DSECND( )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* =====================================================================
+*
+ DSECND = 0.0D+0
+ RETURN
+*
+* End of DSECND
+*
+ END
diff --git a/lapack/ilaclc.f b/lapack/ilaclc.f
new file mode 100644
index 0000000..4ceb61c
--- /dev/null
+++ b/lapack/ilaclc.f
@@ -0,0 +1,118 @@
+*> \brief \b ILACLC
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILACLC + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaclc.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaclc.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaclc.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* INTEGER FUNCTION ILACLC( M, N, A, LDA )
+*
+* .. Scalar Arguments ..
+* INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+* COMPLEX A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ILACLC scans A for its last non-zero column.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N)
+*> 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
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complexOTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILACLC( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+ COMPLEX A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX ZERO
+ PARAMETER ( ZERO = (0.0E+0, 0.0E+0) )
+* ..
+* .. Local Scalars ..
+ INTEGER I
+* ..
+* .. Executable Statements ..
+*
+* Quick test for the common case where one corner is non-zero.
+ IF( N.EQ.0 ) THEN
+ ILACLC = N
+ ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+ ILACLC = N
+ ELSE
+* Now scan each column from the end, returning with the first non-zero.
+ DO ILACLC = N, 1, -1
+ DO I = 1, M
+ IF( A(I, ILACLC).NE.ZERO ) RETURN
+ END DO
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lapack/ilaclr.f b/lapack/ilaclr.f
new file mode 100644
index 0000000..d8ab09c
--- /dev/null
+++ b/lapack/ilaclr.f
@@ -0,0 +1,121 @@
+*> \brief \b ILACLR
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILACLR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaclr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaclr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaclr.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* INTEGER FUNCTION ILACLR( M, N, A, LDA )
+*
+* .. Scalar Arguments ..
+* INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+* COMPLEX A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ILACLR scans A for its last non-zero row.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is array, dimension (LDA,N)
+*> 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
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date April 2012
+*
+*> \ingroup complexOTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILACLR( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* April 2012
+*
+* .. Scalar Arguments ..
+ INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+ COMPLEX A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX ZERO
+ PARAMETER ( ZERO = (0.0E+0, 0.0E+0) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. Executable Statements ..
+*
+* Quick test for the common case where one corner is non-zero.
+ IF( M.EQ.0 ) THEN
+ ILACLR = M
+ ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+ ILACLR = M
+ ELSE
+* Scan up each column tracking the last zero row seen.
+ ILACLR = 0
+ DO J = 1, N
+ I=M
+ DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
+ I=I-1
+ ENDDO
+ ILACLR = MAX( ILACLR, I )
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lapack/iladlc.f b/lapack/iladlc.f
new file mode 100644
index 0000000..f84bd83
--- /dev/null
+++ b/lapack/iladlc.f
@@ -0,0 +1,118 @@
+*> \brief \b ILADLC
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILADLC + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iladlc.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iladlc.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iladlc.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* INTEGER FUNCTION ILADLC( M, N, A, LDA )
+*
+* .. Scalar Arguments ..
+* INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ILADLC scans A for its last non-zero column.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (LDA,N)
+*> 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
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILADLC( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I
+* ..
+* .. Executable Statements ..
+*
+* Quick test for the common case where one corner is non-zero.
+ IF( N.EQ.0 ) THEN
+ ILADLC = N
+ ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+ ILADLC = N
+ ELSE
+* Now scan each column from the end, returning with the first non-zero.
+ DO ILADLC = N, 1, -1
+ DO I = 1, M
+ IF( A(I, ILADLC).NE.ZERO ) RETURN
+ END DO
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lapack/iladlr.f b/lapack/iladlr.f
new file mode 100644
index 0000000..2114c61
--- /dev/null
+++ b/lapack/iladlr.f
@@ -0,0 +1,121 @@
+*> \brief \b ILADLR
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILADLR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iladlr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iladlr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iladlr.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* INTEGER FUNCTION ILADLR( M, N, A, LDA )
+*
+* .. Scalar Arguments ..
+* INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+* DOUBLE PRECISION A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ILADLR scans A for its last non-zero row.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (LDA,N)
+*> 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
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date April 2012
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILADLR( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* April 2012
+*
+* .. Scalar Arguments ..
+ INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. Executable Statements ..
+*
+* Quick test for the common case where one corner is non-zero.
+ IF( M.EQ.0 ) THEN
+ ILADLR = M
+ ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+ ILADLR = M
+ ELSE
+* Scan up each column tracking the last zero row seen.
+ ILADLR = 0
+ DO J = 1, N
+ I=M
+ DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
+ I=I-1
+ ENDDO
+ ILADLR = MAX( ILADLR, I )
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lapack/ilaslc.f b/lapack/ilaslc.f
new file mode 100644
index 0000000..e3db0f4
--- /dev/null
+++ b/lapack/ilaslc.f
@@ -0,0 +1,118 @@
+*> \brief \b ILASLC
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILASLC + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaslc.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaslc.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaslc.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* INTEGER FUNCTION ILASLC( M, N, A, LDA )
+*
+* .. Scalar Arguments ..
+* INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+* REAL A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ILASLC scans A for its last non-zero column.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is REAL array, dimension (LDA,N)
+*> 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
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILASLC( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I
+* ..
+* .. Executable Statements ..
+*
+* Quick test for the common case where one corner is non-zero.
+ IF( N.EQ.0 ) THEN
+ ILASLC = N
+ ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+ ILASLC = N
+ ELSE
+* Now scan each column from the end, returning with the first non-zero.
+ DO ILASLC = N, 1, -1
+ DO I = 1, M
+ IF( A(I, ILASLC).NE.ZERO ) RETURN
+ END DO
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lapack/ilaslr.f b/lapack/ilaslr.f
new file mode 100644
index 0000000..48b73f4
--- /dev/null
+++ b/lapack/ilaslr.f
@@ -0,0 +1,121 @@
+*> \brief \b ILASLR
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILASLR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaslr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaslr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaslr.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* INTEGER FUNCTION ILASLR( M, N, A, LDA )
+*
+* .. Scalar Arguments ..
+* INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+* REAL A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ILASLR scans A for its last non-zero row.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is REAL array, dimension (LDA,N)
+*> 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
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date April 2012
+*
+*> \ingroup realOTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILASLR( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* April 2012
+*
+* .. Scalar Arguments ..
+ INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. Executable Statements ..
+*
+* Quick test for the common case where one corner is non-zero.
+ IF( M.EQ.0 ) THEN
+ ILASLR = M
+ ELSEIF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+ ILASLR = M
+ ELSE
+* Scan up each column tracking the last zero row seen.
+ ILASLR = 0
+ DO J = 1, N
+ I=M
+ DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
+ I=I-1
+ ENDDO
+ ILASLR = MAX( ILASLR, I )
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lapack/ilazlc.f b/lapack/ilazlc.f
new file mode 100644
index 0000000..15b1490
--- /dev/null
+++ b/lapack/ilazlc.f
@@ -0,0 +1,118 @@
+*> \brief \b ILAZLC
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILAZLC + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilazlc.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilazlc.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilazlc.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* INTEGER FUNCTION ILAZLC( M, N, A, LDA )
+*
+* .. Scalar Arguments ..
+* INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ILAZLC scans A for its last non-zero column.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> 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
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILAZLC( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = (0.0D+0, 0.0D+0) )
+* ..
+* .. Local Scalars ..
+ INTEGER I
+* ..
+* .. Executable Statements ..
+*
+* Quick test for the common case where one corner is non-zero.
+ IF( N.EQ.0 ) THEN
+ ILAZLC = N
+ ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+ ILAZLC = N
+ ELSE
+* Now scan each column from the end, returning with the first non-zero.
+ DO ILAZLC = N, 1, -1
+ DO I = 1, M
+ IF( A(I, ILAZLC).NE.ZERO ) RETURN
+ END DO
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lapack/ilazlr.f b/lapack/ilazlr.f
new file mode 100644
index 0000000..b2ab943
--- /dev/null
+++ b/lapack/ilazlr.f
@@ -0,0 +1,121 @@
+*> \brief \b ILAZLR
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ILAZLR + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilazlr.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilazlr.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilazlr.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* INTEGER FUNCTION ILAZLR( M, N, A, LDA )
+*
+* .. Scalar Arguments ..
+* INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ILAZLR scans A for its last non-zero row.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N)
+*> 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
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date April 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ INTEGER FUNCTION ILAZLR( M, N, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 3.4.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* April 2012
+*
+* .. Scalar Arguments ..
+ INTEGER M, N, LDA
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = (0.0D+0, 0.0D+0) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. Executable Statements ..
+*
+* Quick test for the common case where one corner is non-zero.
+ IF( M.EQ.0 ) THEN
+ ILAZLR = M
+ ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+ ILAZLR = M
+ ELSE
+* Scan up each column tracking the last zero row seen.
+ ILAZLR = 0
+ DO J = 1, N
+ I=M
+ DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
+ I=I-1
+ ENDDO
+ ILAZLR = MAX( ILAZLR, I )
+ END DO
+ END IF
+ RETURN
+ END
diff --git a/lapack/lu.cpp b/lapack/lu.cpp
index 3115116..90cebe0 100644
--- a/lapack/lu.cpp
+++ b/lapack/lu.cpp
@@ -28,8 +28,8 @@
Scalar* a = reinterpret_cast<Scalar*>(pa);
int nb_transpositions;
- int ret = Eigen::internal::partial_lu_impl<Scalar,ColMajor,int>
- ::blocked_lu(*m, *n, a, *lda, ipiv, nb_transpositions);
+ int ret = int(Eigen::internal::partial_lu_impl<Scalar,ColMajor,int>
+ ::blocked_lu(*m, *n, a, *lda, ipiv, nb_transpositions));
for(int i=0; i<std::min(*m,*n); ++i)
ipiv[i]++;
diff --git a/lapack/second_NONE.f b/lapack/second_NONE.f
new file mode 100644
index 0000000..d3e6d33
--- /dev/null
+++ b/lapack/second_NONE.f
@@ -0,0 +1,52 @@
+*> \brief \b SECOND returns nothing
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* REAL FUNCTION SECOND( )
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SECOND returns nothing instead of returning the user time for a process in seconds.
+*> If you are using that routine, it means that neither EXTERNAL ETIME,
+*> EXTERNAL ETIME_, INTERNAL ETIME, INTERNAL CPU_TIME is available on
+*> your machine.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ REAL FUNCTION SECOND( )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* =====================================================================
+*
+ SECOND = 0.0E+0
+ RETURN
+*
+* End of SECOND
+*
+ END
diff --git a/lapack/sladiv.f b/lapack/sladiv.f
new file mode 100644
index 0000000..da3afa3
--- /dev/null
+++ b/lapack/sladiv.f
@@ -0,0 +1,128 @@
+*> \brief \b SLADIV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLADIV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sladiv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sladiv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sladiv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SLADIV( A, B, C, D, P, Q )
+*
+* .. Scalar Arguments ..
+* REAL A, B, C, D, P, Q
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLADIV performs complex division in real arithmetic
+*>
+*> a + i*b
+*> p + i*q = ---------
+*> c + i*d
+*>
+*> The algorithm is due to Robert L. Smith and can be found
+*> in D. Knuth, The art of Computer Programming, Vol.2, p.195
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] A
+*> \verbatim
+*> A is REAL
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*> B is REAL
+*> \endverbatim
+*>
+*> \param[in] C
+*> \verbatim
+*> C is REAL
+*> \endverbatim
+*>
+*> \param[in] D
+*> \verbatim
+*> D is REAL
+*> The scalars a, b, c, and d in the above expression.
+*> \endverbatim
+*>
+*> \param[out] P
+*> \verbatim
+*> P is REAL
+*> \endverbatim
+*>
+*> \param[out] Q
+*> \verbatim
+*> Q is REAL
+*> The scalars p and q in the above expression.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE SLADIV( A, B, C, D, P, Q )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ REAL A, B, C, D, P, Q
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ REAL E, F
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS
+* ..
+* .. Executable Statements ..
+*
+ IF( ABS( D ).LT.ABS( C ) ) THEN
+ E = D / C
+ F = C + D*E
+ P = ( A+B*E ) / F
+ Q = ( B-A*E ) / F
+ ELSE
+ E = C / D
+ F = D + C*E
+ P = ( B+A*E ) / F
+ Q = ( -A+B*E ) / F
+ END IF
+*
+ RETURN
+*
+* End of SLADIV
+*
+ END
diff --git a/lapack/slamch.f b/lapack/slamch.f
new file mode 100644
index 0000000..4bffad0
--- /dev/null
+++ b/lapack/slamch.f
@@ -0,0 +1,192 @@
+*> \brief \b SLAMCH
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition:
+* ===========
+*
+* REAL FUNCTION SLAMCH( CMACH )
+*
+* .. Scalar Arguments ..
+* CHARACTER CMACH
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLAMCH determines single precision machine parameters.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] CMACH
+*> \verbatim
+*> Specifies the value to be returned by SLAMCH:
+*> = 'E' or 'e', SLAMCH := eps
+*> = 'S' or 's , SLAMCH := sfmin
+*> = 'B' or 'b', SLAMCH := base
+*> = 'P' or 'p', SLAMCH := eps*base
+*> = 'N' or 'n', SLAMCH := t
+*> = 'R' or 'r', SLAMCH := rnd
+*> = 'M' or 'm', SLAMCH := emin
+*> = 'U' or 'u', SLAMCH := rmin
+*> = 'L' or 'l', SLAMCH := emax
+*> = 'O' or 'o', SLAMCH := rmax
+*> where
+*> eps = relative machine precision
+*> sfmin = safe minimum, such that 1/sfmin does not overflow
+*> base = base of the machine
+*> prec = eps*base
+*> t = number of (base) digits in the mantissa
+*> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+*> emin = minimum exponent before (gradual) underflow
+*> rmin = underflow threshold - base**(emin-1)
+*> emax = largest exponent before overflow
+*> rmax = overflow threshold - (base**emax)*(1-eps)
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ REAL FUNCTION SLAMCH( CMACH )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER CMACH
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ REAL RND, EPS, SFMIN, SMALL, RMACH
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
+ $ MINEXPONENT, RADIX, TINY
+* ..
+* .. Executable Statements ..
+*
+*
+* Assume rounding, not chopping. Always.
+*
+ RND = ONE
+*
+ IF( ONE.EQ.RND ) THEN
+ EPS = EPSILON(ZERO) * 0.5
+ ELSE
+ EPS = EPSILON(ZERO)
+ END IF
+*
+ IF( LSAME( CMACH, 'E' ) ) THEN
+ RMACH = EPS
+ ELSE IF( LSAME( CMACH, 'S' ) ) THEN
+ SFMIN = TINY(ZERO)
+ SMALL = ONE / HUGE(ZERO)
+ IF( SMALL.GE.SFMIN ) THEN
+*
+* Use SMALL plus a bit, to avoid the possibility of rounding
+* causing overflow when computing 1/sfmin.
+*
+ SFMIN = SMALL*( ONE+EPS )
+ END IF
+ RMACH = SFMIN
+ ELSE IF( LSAME( CMACH, 'B' ) ) THEN
+ RMACH = RADIX(ZERO)
+ ELSE IF( LSAME( CMACH, 'P' ) ) THEN
+ RMACH = EPS * RADIX(ZERO)
+ ELSE IF( LSAME( CMACH, 'N' ) ) THEN
+ RMACH = DIGITS(ZERO)
+ ELSE IF( LSAME( CMACH, 'R' ) ) THEN
+ RMACH = RND
+ ELSE IF( LSAME( CMACH, 'M' ) ) THEN
+ RMACH = MINEXPONENT(ZERO)
+ ELSE IF( LSAME( CMACH, 'U' ) ) THEN
+ RMACH = tiny(zero)
+ ELSE IF( LSAME( CMACH, 'L' ) ) THEN
+ RMACH = MAXEXPONENT(ZERO)
+ ELSE IF( LSAME( CMACH, 'O' ) ) THEN
+ RMACH = HUGE(ZERO)
+ ELSE
+ RMACH = ZERO
+ END IF
+*
+ SLAMCH = RMACH
+ RETURN
+*
+* End of SLAMCH
+*
+ END
+************************************************************************
+*> \brief \b SLAMC3
+*> \details
+*> \b Purpose:
+*> \verbatim
+*> SLAMC3 is intended to force A and B to be stored prior to doing
+*> the addition of A and B , for use in situations where optimizers
+*> might hold one of these in a register.
+*> \endverbatim
+*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
+*> \date November 2011
+*> \ingroup auxOTHERauxiliary
+*>
+*> \param[in] A
+*> \verbatim
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*> The values A and B.
+*> \endverbatim
+*>
+*
+ REAL FUNCTION SLAMC3( A, B )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+* November 2010
+*
+* .. Scalar Arguments ..
+ REAL A, B
+* ..
+* =====================================================================
+*
+* .. Executable Statements ..
+*
+ SLAMC3 = A + B
+*
+ RETURN
+*
+* End of SLAMC3
+*
+ END
+*
+************************************************************************
diff --git a/lapack/slapy2.f b/lapack/slapy2.f
new file mode 100644
index 0000000..1f6b1ca
--- /dev/null
+++ b/lapack/slapy2.f
@@ -0,0 +1,104 @@
+*> \brief \b SLAPY2
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLAPY2 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy2.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy2.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy2.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* REAL FUNCTION SLAPY2( X, Y )
+*
+* .. Scalar Arguments ..
+* REAL X, Y
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+*> overflow.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] X
+*> \verbatim
+*> X is REAL
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*> Y is REAL
+*> X and Y specify the values x and y.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ REAL FUNCTION SLAPY2( X, Y )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ REAL X, Y
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E0 )
+ REAL ONE
+ PARAMETER ( ONE = 1.0E0 )
+* ..
+* .. Local Scalars ..
+ REAL W, XABS, YABS, Z
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ W = MAX( XABS, YABS )
+ Z = MIN( XABS, YABS )
+ IF( Z.EQ.ZERO ) THEN
+ SLAPY2 = W
+ ELSE
+ SLAPY2 = W*SQRT( ONE+( Z / W )**2 )
+ END IF
+ RETURN
+*
+* End of SLAPY2
+*
+ END
diff --git a/lapack/slapy3.f b/lapack/slapy3.f
new file mode 100644
index 0000000..aa2f5bf
--- /dev/null
+++ b/lapack/slapy3.f
@@ -0,0 +1,111 @@
+*> \brief \b SLAPY3
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLAPY3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy3.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* REAL FUNCTION SLAPY3( X, Y, Z )
+*
+* .. Scalar Arguments ..
+* REAL X, Y, Z
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
+*> unnecessary overflow.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] X
+*> \verbatim
+*> X is REAL
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*> Y is REAL
+*> \endverbatim
+*>
+*> \param[in] Z
+*> \verbatim
+*> Z is REAL
+*> X, Y and Z specify the values x, y and z.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+* =====================================================================
+ REAL FUNCTION SLAPY3( X, Y, Z )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ REAL X, Y, Z
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E0 )
+* ..
+* .. Local Scalars ..
+ REAL W, XABS, YABS, ZABS
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, SQRT
+* ..
+* .. Executable Statements ..
+*
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ ZABS = ABS( Z )
+ W = MAX( XABS, YABS, ZABS )
+ IF( W.EQ.ZERO ) THEN
+* W can be zero for max(0,nan,0)
+* adding all three entries together will make sure
+* NaN will not disappear.
+ SLAPY3 = XABS + YABS + ZABS
+ ELSE
+ SLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
+ $ ( ZABS / W )**2 )
+ END IF
+ RETURN
+*
+* End of SLAPY3
+*
+ END
diff --git a/lapack/slarf.f b/lapack/slarf.f
new file mode 100644
index 0000000..8a8ff30
--- /dev/null
+++ b/lapack/slarf.f
@@ -0,0 +1,227 @@
+*> \brief \b SLARF
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLARF + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarf.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarf.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarf.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER SIDE
+* INTEGER INCV, LDC, M, N
+* REAL TAU
+* ..
+* .. Array Arguments ..
+* REAL C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLARF applies a real elementary reflector H to a real m by n matrix
+*> C, from either the left or the right. H is represented in the form
+*>
+*> H = I - tau * v * v**T
+*>
+*> where tau is a real scalar and v is a real vector.
+*>
+*> If tau = 0, then H is taken to be the unit matrix.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is CHARACTER*1
+*> = 'L': form H * C
+*> = 'R': form C * H
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is REAL array, dimension
+*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+*> The vector v in the representation of H. V is not used if
+*> TAU = 0.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*> INCV is INTEGER
+*> The increment between elements of v. INCV <> 0.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*> TAU is REAL
+*> The value tau in the representation of H.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is REAL array, dimension (LDC,N)
+*> On entry, the m by n matrix C.
+*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+*> or C * H if SIDE = 'R'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL array, dimension
+*> (N) if SIDE = 'L'
+*> or (M) if SIDE = 'R'
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE
+ INTEGER INCV, LDC, M, N
+ REAL TAU
+* ..
+* .. Array Arguments ..
+ REAL C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL APPLYLEFT
+ INTEGER I, LASTV, LASTC
+* ..
+* .. External Subroutines ..
+ EXTERNAL SGEMV, SGER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILASLR, ILASLC
+ EXTERNAL LSAME, ILASLR, ILASLC
+* ..
+* .. Executable Statements ..
+*
+ APPLYLEFT = LSAME( SIDE, 'L' )
+ LASTV = 0
+ LASTC = 0
+ IF( TAU.NE.ZERO ) THEN
+! Set up variables for scanning V. LASTV begins pointing to the end
+! of V.
+ IF( APPLYLEFT ) THEN
+ LASTV = M
+ ELSE
+ LASTV = N
+ END IF
+ IF( INCV.GT.0 ) THEN
+ I = 1 + (LASTV-1) * INCV
+ ELSE
+ I = 1
+ END IF
+! Look for the last non-zero row in V.
+ DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
+ LASTV = LASTV - 1
+ I = I - INCV
+ END DO
+ IF( APPLYLEFT ) THEN
+! Scan for the last non-zero column in C(1:lastv,:).
+ LASTC = ILASLC(LASTV, N, C, LDC)
+ ELSE
+! Scan for the last non-zero row in C(:,1:lastv).
+ LASTC = ILASLR(M, LASTV, C, LDC)
+ END IF
+ END IF
+! Note that lastc.eq.0 renders the BLAS operations null; no special
+! case is needed at this level.
+ IF( APPLYLEFT ) THEN
+*
+* Form H * C
+*
+ IF( LASTV.GT.0 ) THEN
+*
+* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
+*
+ CALL SGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
+ $ ZERO, WORK, 1 )
+*
+* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
+*
+ CALL SGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
+ END IF
+ ELSE
+*
+* Form C * H
+*
+ IF( LASTV.GT.0 ) THEN
+*
+* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
+*
+ CALL SGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
+ $ V, INCV, ZERO, WORK, 1 )
+*
+* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
+*
+ CALL SGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
+ END IF
+ END IF
+ RETURN
+*
+* End of SLARF
+*
+ END
diff --git a/lapack/slarfb.f b/lapack/slarfb.f
new file mode 100644
index 0000000..eb95990
--- /dev/null
+++ b/lapack/slarfb.f
@@ -0,0 +1,763 @@
+*> \brief \b SLARFB
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLARFB + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfb.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfb.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfb.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+* T, LDT, C, LDC, WORK, LDWORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, SIDE, STOREV, TRANS
+* INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+* REAL C( LDC, * ), T( LDT, * ), V( LDV, * ),
+* $ WORK( LDWORK, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLARFB applies a real block reflector H or its transpose H**T to a
+*> real m by n matrix C, from either the left or the right.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is CHARACTER*1
+*> = 'L': apply H or H**T from the Left
+*> = 'R': apply H or H**T from the Right
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*> TRANS is CHARACTER*1
+*> = 'N': apply H (No transpose)
+*> = 'T': apply H**T (Transpose)
+*> \endverbatim
+*>
+*> \param[in] DIRECT
+*> \verbatim
+*> DIRECT is CHARACTER*1
+*> Indicates how H is formed from a product of elementary
+*> reflectors
+*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*> STOREV is CHARACTER*1
+*> Indicates how the vectors which define the elementary
+*> reflectors are stored:
+*> = 'C': Columnwise
+*> = 'R': Rowwise
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> The order of the matrix T (= the number of elementary
+*> reflectors whose product defines the block reflector).
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is REAL array, dimension
+*> (LDV,K) if STOREV = 'C'
+*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
+*> (LDV,N) if STOREV = 'R' and SIDE = 'R'
+*> The matrix V. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V.
+*> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+*> if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*> T is REAL array, dimension (LDT,K)
+*> The triangular k by k matrix T in the representation of the
+*> block reflector.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*> LDT is INTEGER
+*> The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is REAL array, dimension (LDC,N)
+*> On entry, the m by n matrix C.
+*> On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL array, dimension (LDWORK,K)
+*> \endverbatim
+*>
+*> \param[in] LDWORK
+*> \verbatim
+*> LDWORK is INTEGER
+*> The leading dimension of the array WORK.
+*> If SIDE = 'L', LDWORK >= max(1,N);
+*> if SIDE = 'R', LDWORK >= max(1,M).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> The shape of the matrix V and the storage of the vectors which define
+*> the H(i) is best illustrated by the following example with n = 5 and
+*> k = 3. The elements equal to 1 are not stored; the corresponding
+*> array elements are modified but restored on exit. The rest of the
+*> array is not used.
+*>
+*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*>
+*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+*> ( v1 1 ) ( 1 v2 v2 v2 )
+*> ( v1 v2 1 ) ( 1 v3 v3 )
+*> ( v1 v2 v3 )
+*> ( v1 v2 v3 )
+*>
+*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*>
+*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
+*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+*> ( 1 v3 )
+*> ( 1 )
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+ $ T, LDT, C, LDC, WORK, LDWORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, SIDE, STOREV, TRANS
+ INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+ REAL C( LDC, * ), T( LDT, * ), V( LDV, * ),
+ $ WORK( LDWORK, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE
+ PARAMETER ( ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ CHARACTER TRANST
+ INTEGER I, J, LASTV, LASTC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILASLR, ILASLC
+ EXTERNAL LSAME, ILASLR, ILASLC
+* ..
+* .. External Subroutines ..
+ EXTERNAL SCOPY, SGEMM, STRMM
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( M.LE.0 .OR. N.LE.0 )
+ $ RETURN
+*
+ IF( LSAME( TRANS, 'N' ) ) THEN
+ TRANST = 'T'
+ ELSE
+ TRANST = 'N'
+ END IF
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 ) (first K rows)
+* ( V2 )
+* where V1 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**T * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILASLR( M, K, V, LDV ) )
+ LASTC = ILASLC( LASTV, N, C, LDC )
+*
+* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
+*
+* W := C1**T
+*
+ DO 10 J = 1, K
+ CALL SCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ 10 CONTINUE
+*
+* W := W * V1
+*
+ CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**T *V2
+*
+ CALL SGEMM( 'Transpose', 'No transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**T or W * T
+*
+ CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - V2 * W**T
+*
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ LASTV-K, LASTC, K,
+ $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
+ $ C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1**T
+*
+ CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**T
+*
+ DO 30 J = 1, K
+ DO 20 I = 1, LASTC
+ C( J, I ) = C( J, I ) - WORK( I, J )
+ 20 CONTINUE
+ 30 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**T where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILASLR( N, K, V, LDV ) )
+ LASTC = ILASLR( M, LASTV, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C1
+*
+ DO 40 J = 1, K
+ CALL SCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 40 CONTINUE
+*
+* W := W * V1
+*
+ CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2
+*
+ CALL SGEMM( 'No transpose', 'No transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**T
+*
+ CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - W * V2**T
+*
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ LASTC, LASTV-K, K,
+ $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
+ $ C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1**T
+*
+ CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 60 J = 1, K
+ DO 50 I = 1, LASTC
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 )
+* ( V2 ) (last K rows)
+* where V2 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**T * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILASLR( M, K, V, LDV ) )
+ LASTC = ILASLC( LASTV, N, C, LDC )
+*
+* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK)
+*
+* W := C2**T
+*
+ DO 70 J = 1, K
+ CALL SCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ 70 CONTINUE
+*
+* W := W * V2
+*
+ CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1**T*V1
+*
+ CALL SGEMM( 'Transpose', 'No transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**T or W * T
+*
+ CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - V1 * W**T
+*
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**T
+*
+ CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**T
+*
+ DO 90 J = 1, K
+ DO 80 I = 1, LASTC
+ C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+ 80 CONTINUE
+ 90 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**T where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILASLR( N, K, V, LDV ) )
+ LASTC = ILASLR( M, LASTV, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C2
+*
+ DO 100 J = 1, K
+ CALL SCOPY( LASTC, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
+ 100 CONTINUE
+*
+* W := W * V2
+*
+ CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1 * V1
+*
+ CALL SGEMM( 'No transpose', 'No transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**T
+*
+ CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - W * V1**T
+*
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**T
+*
+ CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W
+*
+ DO 120 J = 1, K
+ DO 110 I = 1, LASTC
+ C( I, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J)
+ 110 CONTINUE
+ 120 CONTINUE
+ END IF
+ END IF
+*
+ ELSE IF( LSAME( STOREV, 'R' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 V2 ) (V1: first K columns)
+* where V1 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**T * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILASLC( K, M, V, LDV ) )
+ LASTC = ILASLC( LASTV, N, C, LDC )
+*
+* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
+*
+* W := C1**T
+*
+ DO 130 J = 1, K
+ CALL SCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ 130 CONTINUE
+*
+* W := W * V1**T
+*
+ CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**T*V2**T
+*
+ CALL SGEMM( 'Transpose', 'Transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**T or W * T
+*
+ CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**T * W**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - V2**T * W**T
+*
+ CALL SGEMM( 'Transpose', 'Transpose',
+ $ LASTV-K, LASTC, K,
+ $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
+ $ ONE, C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**T
+*
+ DO 150 J = 1, K
+ DO 140 I = 1, LASTC
+ C( J, I ) = C( J, I ) - WORK( I, J )
+ 140 CONTINUE
+ 150 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**T where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILASLC( K, N, V, LDV ) )
+ LASTC = ILASLR( M, LASTV, C, LDC )
+*
+* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
+*
+* W := C1
+*
+ DO 160 J = 1, K
+ CALL SCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 160 CONTINUE
+*
+* W := W * V1**T
+*
+ CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2**T
+*
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**T
+*
+ CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - W * V2
+*
+ CALL SGEMM( 'No transpose', 'No transpose',
+ $ LASTC, LASTV-K, K,
+ $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
+ $ ONE, C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 180 J = 1, K
+ DO 170 I = 1, LASTC
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 170 CONTINUE
+ 180 CONTINUE
+*
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 V2 ) (V2: last K columns)
+* where V2 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**T * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILASLC( K, M, V, LDV ) )
+ LASTC = ILASLC( LASTV, N, C, LDC )
+*
+* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
+*
+* W := C2**T
+*
+ DO 190 J = 1, K
+ CALL SCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ 190 CONTINUE
+*
+* W := W * V2**T
+*
+ CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1**T * V1**T
+*
+ CALL SGEMM( 'Transpose', 'Transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**T or W * T
+*
+ CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**T * W**T
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - V1**T * W**T
+*
+ CALL SGEMM( 'Transpose', 'Transpose',
+ $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**T
+*
+ DO 210 J = 1, K
+ DO 200 I = 1, LASTC
+ C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+ 200 CONTINUE
+ 210 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**T where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILASLC( K, N, V, LDV ) )
+ LASTC = ILASLR( M, LASTV, C, LDC )
+*
+* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
+*
+* W := C2
+*
+ DO 220 J = 1, K
+ CALL SCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ $ WORK( 1, J ), 1 )
+ 220 CONTINUE
+*
+* W := W * V2**T
+*
+ CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1 * V1**T
+*
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**T
+*
+ CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - W * V1
+*
+ CALL SGEMM( 'No transpose', 'No transpose',
+ $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 240 J = 1, K
+ DO 230 I = 1, LASTC
+ C( I, LASTV-K+J ) = C( I, LASTV-K+J )
+ $ - WORK( I, J )
+ 230 CONTINUE
+ 240 CONTINUE
+*
+ END IF
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of SLARFB
+*
+ END
diff --git a/lapack/slarfg.f b/lapack/slarfg.f
new file mode 100644
index 0000000..4f10ffc
--- /dev/null
+++ b/lapack/slarfg.f
@@ -0,0 +1,196 @@
+*> \brief \b SLARFG
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLARFG + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfg.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfg.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfg.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
+*
+* .. Scalar Arguments ..
+* INTEGER INCX, N
+* REAL ALPHA, TAU
+* ..
+* .. Array Arguments ..
+* REAL X( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLARFG generates a real elementary reflector H of order n, such
+*> that
+*>
+*> H * ( alpha ) = ( beta ), H**T * H = I.
+*> ( x ) ( 0 )
+*>
+*> where alpha and beta are scalars, and x is an (n-1)-element real
+*> vector. H is represented in the form
+*>
+*> H = I - tau * ( 1 ) * ( 1 v**T ) ,
+*> ( v )
+*>
+*> where tau is a real scalar and v is a real (n-1)-element
+*> vector.
+*>
+*> If the elements of x are all zero, then tau = 0 and H is taken to be
+*> the unit matrix.
+*>
+*> Otherwise 1 <= tau <= 2.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the elementary reflector.
+*> \endverbatim
+*>
+*> \param[in,out] ALPHA
+*> \verbatim
+*> ALPHA is REAL
+*> On entry, the value alpha.
+*> On exit, it is overwritten with the value beta.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*> X is REAL array, dimension
+*> (1+(N-2)*abs(INCX))
+*> On entry, the vector x.
+*> On exit, it is overwritten with the vector v.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> The increment between elements of X. INCX > 0.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is REAL
+*> The value tau.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ REAL ALPHA, TAU
+* ..
+* .. Array Arguments ..
+ REAL X( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER J, KNT
+ REAL BETA, RSAFMN, SAFMIN, XNORM
+* ..
+* .. External Functions ..
+ REAL SLAMCH, SLAPY2, SNRM2
+ EXTERNAL SLAMCH, SLAPY2, SNRM2
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, SIGN
+* ..
+* .. External Subroutines ..
+ EXTERNAL SSCAL
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.1 ) THEN
+ TAU = ZERO
+ RETURN
+ END IF
+*
+ XNORM = SNRM2( N-1, X, INCX )
+*
+ IF( XNORM.EQ.ZERO ) THEN
+*
+* H = I
+*
+ TAU = ZERO
+ ELSE
+*
+* general case
+*
+ BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
+ SAFMIN = SLAMCH( 'S' ) / SLAMCH( 'E' )
+ KNT = 0
+ IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+* XNORM, BETA may be inaccurate; scale X and recompute them
+*
+ RSAFMN = ONE / SAFMIN
+ 10 CONTINUE
+ KNT = KNT + 1
+ CALL SSCAL( N-1, RSAFMN, X, INCX )
+ BETA = BETA*RSAFMN
+ ALPHA = ALPHA*RSAFMN
+ IF( ABS( BETA ).LT.SAFMIN )
+ $ GO TO 10
+*
+* New BETA is at most 1, at least SAFMIN
+*
+ XNORM = SNRM2( N-1, X, INCX )
+ BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
+ END IF
+ TAU = ( BETA-ALPHA ) / BETA
+ CALL SSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
+*
+* If ALPHA is subnormal, it may lose relative accuracy
+*
+ DO 20 J = 1, KNT
+ BETA = BETA*SAFMIN
+ 20 CONTINUE
+ ALPHA = BETA
+ END IF
+*
+ RETURN
+*
+* End of SLARFG
+*
+ END
diff --git a/lapack/slarft.f b/lapack/slarft.f
new file mode 100644
index 0000000..30b0668
--- /dev/null
+++ b/lapack/slarft.f
@@ -0,0 +1,326 @@
+*> \brief \b SLARFT
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLARFT + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarft.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarft.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarft.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, STOREV
+* INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+* REAL T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLARFT forms the triangular factor T of a real block reflector H
+*> of order n, which is defined as a product of k elementary reflectors.
+*>
+*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+*>
+*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+*>
+*> If STOREV = 'C', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th column of the array V, and
+*>
+*> H = I - V * T * V**T
+*>
+*> If STOREV = 'R', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th row of the array V, and
+*>
+*> H = I - V**T * T * V
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DIRECT
+*> \verbatim
+*> DIRECT is CHARACTER*1
+*> Specifies the order in which the elementary reflectors are
+*> multiplied to form the block reflector:
+*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*> STOREV is CHARACTER*1
+*> Specifies how the vectors which define the elementary
+*> reflectors are stored (see also Further Details):
+*> = 'C': columnwise
+*> = 'R': rowwise
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the block reflector H. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> The order of the triangular factor T (= the number of
+*> elementary reflectors). K >= 1.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is REAL array, dimension
+*> (LDV,K) if STOREV = 'C'
+*> (LDV,N) if STOREV = 'R'
+*> The matrix V. See further details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V.
+*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*> TAU is REAL array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*> T is REAL array, dimension (LDT,K)
+*> The k by k triangular factor T of the block reflector.
+*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+*> lower triangular. The rest of the array is not used.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*> LDT is INTEGER
+*> The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date April 2012
+*
+*> \ingroup realOTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> The shape of the matrix V and the storage of the vectors which define
+*> the H(i) is best illustrated by the following example with n = 5 and
+*> k = 3. The elements equal to 1 are not stored.
+*>
+*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*>
+*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+*> ( v1 1 ) ( 1 v2 v2 v2 )
+*> ( v1 v2 1 ) ( 1 v3 v3 )
+*> ( v1 v2 v3 )
+*> ( v1 v2 v3 )
+*>
+*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*>
+*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
+*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+*> ( 1 v3 )
+*> ( 1 )
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* -- LAPACK auxiliary routine (version 3.4.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* April 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, STOREV
+ INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+ REAL T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J, PREVLASTV, LASTV
+* ..
+* .. External Subroutines ..
+ EXTERNAL SGEMV, STRMV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+ PREVLASTV = N
+ DO I = 1, K
+ PREVLASTV = MAX( I, PREVLASTV )
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO J = 1, I
+ T( J, I ) = ZERO
+ END DO
+ ELSE
+*
+* general case
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+* Skip any trailing zeros.
+ DO LASTV = N, I+1, -1
+ IF( V( LASTV, I ).NE.ZERO ) EXIT
+ END DO
+ DO J = 1, I-1
+ T( J, I ) = -TAU( I ) * V( I , J )
+ END DO
+ J = MIN( LASTV, PREVLASTV )
+*
+* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i)
+*
+ CALL SGEMV( 'Transpose', J-I, I-1, -TAU( I ),
+ $ V( I+1, 1 ), LDV, V( I+1, I ), 1, ONE,
+ $ T( 1, I ), 1 )
+ ELSE
+* Skip any trailing zeros.
+ DO LASTV = N, I+1, -1
+ IF( V( I, LASTV ).NE.ZERO ) EXIT
+ END DO
+ DO J = 1, I-1
+ T( J, I ) = -TAU( I ) * V( J , I )
+ END DO
+ J = MIN( LASTV, PREVLASTV )
+*
+* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T
+*
+ CALL SGEMV( 'No transpose', I-1, J-I, -TAU( I ),
+ $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV,
+ $ ONE, T( 1, I ), 1 )
+ END IF
+*
+* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
+*
+ CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
+ $ LDT, T( 1, I ), 1 )
+ T( I, I ) = TAU( I )
+ IF( I.GT.1 ) THEN
+ PREVLASTV = MAX( PREVLASTV, LASTV )
+ ELSE
+ PREVLASTV = LASTV
+ END IF
+ END IF
+ END DO
+ ELSE
+ PREVLASTV = 1
+ DO I = K, 1, -1
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO J = I, K
+ T( J, I ) = ZERO
+ END DO
+ ELSE
+*
+* general case
+*
+ IF( I.LT.K ) THEN
+ IF( LSAME( STOREV, 'C' ) ) THEN
+* Skip any leading zeros.
+ DO LASTV = 1, I-1
+ IF( V( LASTV, I ).NE.ZERO ) EXIT
+ END DO
+ DO J = I+1, K
+ T( J, I ) = -TAU( I ) * V( N-K+I , J )
+ END DO
+ J = MAX( LASTV, PREVLASTV )
+*
+* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i)
+*
+ CALL SGEMV( 'Transpose', N-K+I-J, K-I, -TAU( I ),
+ $ V( J, I+1 ), LDV, V( J, I ), 1, ONE,
+ $ T( I+1, I ), 1 )
+ ELSE
+* Skip any leading zeros.
+ DO LASTV = 1, I-1
+ IF( V( I, LASTV ).NE.ZERO ) EXIT
+ END DO
+ DO J = I+1, K
+ T( J, I ) = -TAU( I ) * V( J, N-K+I )
+ END DO
+ J = MAX( LASTV, PREVLASTV )
+*
+* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T
+*
+ CALL SGEMV( 'No transpose', K-I, N-K+I-J,
+ $ -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV,
+ $ ONE, T( I+1, I ), 1 )
+ END IF
+*
+* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
+*
+ CALL STRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
+ $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
+ IF( I.GT.1 ) THEN
+ PREVLASTV = MIN( PREVLASTV, LASTV )
+ ELSE
+ PREVLASTV = LASTV
+ END IF
+ END IF
+ T( I, I ) = TAU( I )
+ END IF
+ END DO
+ END IF
+ RETURN
+*
+* End of SLARFT
+*
+ END
diff --git a/lapack/zlacgv.f b/lapack/zlacgv.f
new file mode 100644
index 0000000..16c2e2e
--- /dev/null
+++ b/lapack/zlacgv.f
@@ -0,0 +1,116 @@
+*> \brief \b ZLACGV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLACGV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlacgv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlacgv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlacgv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLACGV( N, X, INCX )
+*
+* .. Scalar Arguments ..
+* INTEGER INCX, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 X( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLACGV conjugates a complex vector of length N.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The length of the vector X. N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*> X is COMPLEX*16 array, dimension
+*> (1+(N-1)*abs(INCX))
+*> On entry, the vector of length N to be conjugated.
+*> On exit, X is overwritten with conjg(X).
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> The spacing between successive elements of X.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLACGV( N, X, INCX )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 X( * )
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, IOFF
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG
+* ..
+* .. Executable Statements ..
+*
+ IF( INCX.EQ.1 ) THEN
+ DO 10 I = 1, N
+ X( I ) = DCONJG( X( I ) )
+ 10 CONTINUE
+ ELSE
+ IOFF = 1
+ IF( INCX.LT.0 )
+ $ IOFF = 1 - ( N-1 )*INCX
+ DO 20 I = 1, N
+ X( IOFF ) = DCONJG( X( IOFF ) )
+ IOFF = IOFF + INCX
+ 20 CONTINUE
+ END IF
+ RETURN
+*
+* End of ZLACGV
+*
+ END
diff --git a/lapack/zladiv.f b/lapack/zladiv.f
new file mode 100644
index 0000000..aa71db1
--- /dev/null
+++ b/lapack/zladiv.f
@@ -0,0 +1,97 @@
+*> \brief \b ZLADIV
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLADIV + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zladiv.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zladiv.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zladiv.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* COMPLEX*16 FUNCTION ZLADIV( X, Y )
+*
+* .. Scalar Arguments ..
+* COMPLEX*16 X, Y
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLADIV := X / Y, where X and Y are complex. The computation of X / Y
+*> will not overflow on an intermediary step unless the results
+*> overflows.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] X
+*> \verbatim
+*> X is COMPLEX*16
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*> Y is COMPLEX*16
+*> The complex scalars X and Y.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ COMPLEX*16 FUNCTION ZLADIV( X, Y )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ COMPLEX*16 X, Y
+* ..
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ DOUBLE PRECISION ZI, ZR
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLADIV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE, DCMPLX, DIMAG
+* ..
+* .. Executable Statements ..
+*
+ CALL DLADIV( DBLE( X ), DIMAG( X ), DBLE( Y ), DIMAG( Y ), ZR,
+ $ ZI )
+ ZLADIV = DCMPLX( ZR, ZI )
+*
+ RETURN
+*
+* End of ZLADIV
+*
+ END
diff --git a/lapack/zlarf.f b/lapack/zlarf.f
new file mode 100644
index 0000000..53f314d
--- /dev/null
+++ b/lapack/zlarf.f
@@ -0,0 +1,232 @@
+*> \brief \b ZLARF
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARF + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarf.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarf.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarf.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER SIDE
+* INTEGER INCV, LDC, M, N
+* COMPLEX*16 TAU
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLARF applies a complex elementary reflector H to a complex M-by-N
+*> matrix C, from either the left or the right. H is represented in the
+*> form
+*>
+*> H = I - tau * v * v**H
+*>
+*> where tau is a complex scalar and v is a complex vector.
+*>
+*> If tau = 0, then H is taken to be the unit matrix.
+*>
+*> To apply H**H, supply conjg(tau) instead
+*> tau.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is CHARACTER*1
+*> = 'L': form H * C
+*> = 'R': form C * H
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is COMPLEX*16 array, dimension
+*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+*> The vector v in the representation of H. V is not used if
+*> TAU = 0.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*> INCV is INTEGER
+*> The increment between elements of v. INCV <> 0.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*> TAU is COMPLEX*16
+*> The value tau in the representation of H.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is COMPLEX*16 array, dimension (LDC,N)
+*> On entry, the M-by-N matrix C.
+*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+*> or C * H if SIDE = 'R'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension
+*> (N) if SIDE = 'L'
+*> or (M) if SIDE = 'R'
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE
+ INTEGER INCV, LDC, M, N
+ COMPLEX*16 TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE, ZERO
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
+ $ ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL APPLYLEFT
+ INTEGER I, LASTV, LASTC
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGEMV, ZGERC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAZLR, ILAZLC
+ EXTERNAL LSAME, ILAZLR, ILAZLC
+* ..
+* .. Executable Statements ..
+*
+ APPLYLEFT = LSAME( SIDE, 'L' )
+ LASTV = 0
+ LASTC = 0
+ IF( TAU.NE.ZERO ) THEN
+* Set up variables for scanning V. LASTV begins pointing to the end
+* of V.
+ IF( APPLYLEFT ) THEN
+ LASTV = M
+ ELSE
+ LASTV = N
+ END IF
+ IF( INCV.GT.0 ) THEN
+ I = 1 + (LASTV-1) * INCV
+ ELSE
+ I = 1
+ END IF
+* Look for the last non-zero row in V.
+ DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
+ LASTV = LASTV - 1
+ I = I - INCV
+ END DO
+ IF( APPLYLEFT ) THEN
+* Scan for the last non-zero column in C(1:lastv,:).
+ LASTC = ILAZLC(LASTV, N, C, LDC)
+ ELSE
+* Scan for the last non-zero row in C(:,1:lastv).
+ LASTC = ILAZLR(M, LASTV, C, LDC)
+ END IF
+ END IF
+* Note that lastc.eq.0 renders the BLAS operations null; no special
+* case is needed at this level.
+ IF( APPLYLEFT ) THEN
+*
+* Form H * C
+*
+ IF( LASTV.GT.0 ) THEN
+*
+* w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1)
+*
+ CALL ZGEMV( 'Conjugate transpose', LASTV, LASTC, ONE,
+ $ C, LDC, V, INCV, ZERO, WORK, 1 )
+*
+* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H
+*
+ CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
+ END IF
+ ELSE
+*
+* Form C * H
+*
+ IF( LASTV.GT.0 ) THEN
+*
+* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
+*
+ CALL ZGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
+ $ V, INCV, ZERO, WORK, 1 )
+*
+* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H
+*
+ CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
+ END IF
+ END IF
+ RETURN
+*
+* End of ZLARF
+*
+ END
diff --git a/lapack/zlarfb.f b/lapack/zlarfb.f
new file mode 100644
index 0000000..30fc4b9
--- /dev/null
+++ b/lapack/zlarfb.f
@@ -0,0 +1,774 @@
+*> \brief \b ZLARFB
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARFB + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarfb.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarfb.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarfb.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+* T, LDT, C, LDC, WORK, LDWORK )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, SIDE, STOREV, TRANS
+* INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 C( LDC, * ), T( LDT, * ), V( LDV, * ),
+* $ WORK( LDWORK, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLARFB applies a complex block reflector H or its transpose H**H to a
+*> complex M-by-N matrix C, from either the left or the right.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*> SIDE is CHARACTER*1
+*> = 'L': apply H or H**H from the Left
+*> = 'R': apply H or H**H from the Right
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*> TRANS is CHARACTER*1
+*> = 'N': apply H (No transpose)
+*> = 'C': apply H**H (Conjugate transpose)
+*> \endverbatim
+*>
+*> \param[in] DIRECT
+*> \verbatim
+*> DIRECT is CHARACTER*1
+*> Indicates how H is formed from a product of elementary
+*> reflectors
+*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*> STOREV is CHARACTER*1
+*> Indicates how the vectors which define the elementary
+*> reflectors are stored:
+*> = 'C': Columnwise
+*> = 'R': Rowwise
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> The order of the matrix T (= the number of elementary
+*> reflectors whose product defines the block reflector).
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is COMPLEX*16 array, dimension
+*> (LDV,K) if STOREV = 'C'
+*> (LDV,M) if STOREV = 'R' and SIDE = 'L'
+*> (LDV,N) if STOREV = 'R' and SIDE = 'R'
+*> See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V.
+*> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+*> if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*> T is COMPLEX*16 array, dimension (LDT,K)
+*> The triangular K-by-K matrix T in the representation of the
+*> block reflector.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*> LDT is INTEGER
+*> The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is COMPLEX*16 array, dimension (LDC,N)
+*> On entry, the M-by-N matrix C.
+*> On exit, C is overwritten by H*C or H**H*C or C*H or C*H**H.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*> LDC is INTEGER
+*> The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension (LDWORK,K)
+*> \endverbatim
+*>
+*> \param[in] LDWORK
+*> \verbatim
+*> LDWORK is INTEGER
+*> The leading dimension of the array WORK.
+*> If SIDE = 'L', LDWORK >= max(1,N);
+*> if SIDE = 'R', LDWORK >= max(1,M).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex16OTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> The shape of the matrix V and the storage of the vectors which define
+*> the H(i) is best illustrated by the following example with n = 5 and
+*> k = 3. The elements equal to 1 are not stored; the corresponding
+*> array elements are modified but restored on exit. The rest of the
+*> array is not used.
+*>
+*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*>
+*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+*> ( v1 1 ) ( 1 v2 v2 v2 )
+*> ( v1 v2 1 ) ( 1 v3 v3 )
+*> ( v1 v2 v3 )
+*> ( v1 v2 v3 )
+*>
+*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*>
+*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
+*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+*> ( 1 v3 )
+*> ( 1 )
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+ $ T, LDT, C, LDC, WORK, LDWORK )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, SIDE, STOREV, TRANS
+ INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 C( LDC, * ), T( LDT, * ), V( LDV, * ),
+ $ WORK( LDWORK, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ CHARACTER TRANST
+ INTEGER I, J, LASTV, LASTC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAZLR, ILAZLC
+ EXTERNAL LSAME, ILAZLR, ILAZLC
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZCOPY, ZGEMM, ZLACGV, ZTRMM
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( M.LE.0 .OR. N.LE.0 )
+ $ RETURN
+*
+ IF( LSAME( TRANS, 'N' ) ) THEN
+ TRANST = 'C'
+ ELSE
+ TRANST = 'N'
+ END IF
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 ) (first K rows)
+* ( V2 )
+* where V1 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
+ LASTC = ILAZLC( LASTV, N, C, LDC )
+*
+* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
+*
+* W := C1**H
+*
+ DO 10 J = 1, K
+ CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
+ 10 CONTINUE
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**H *V2
+*
+ CALL ZGEMM( 'Conjugate transpose', 'No transpose',
+ $ LASTC, K, LASTV-K, ONE, C( K+1, 1 ), LDC,
+ $ V( K+1, 1 ), LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**H
+*
+ IF( M.GT.K ) THEN
+*
+* C2 := C2 - V2 * W**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTV-K, LASTC, K,
+ $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK,
+ $ ONE, C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1**H
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**H
+*
+ DO 30 J = 1, K
+ DO 20 I = 1, LASTC
+ C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
+ 20 CONTINUE
+ 30 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
+ LASTC = ILAZLR( M, LASTV, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C1
+*
+ DO 40 J = 1, K
+ CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 40 CONTINUE
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2
+*
+ CALL ZGEMM( 'No transpose', 'No transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - W * V2**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, LASTV-K, K,
+ $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV,
+ $ ONE, C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1**H
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 60 J = 1, K
+ DO 50 I = 1, LASTC
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 )
+* ( V2 ) (last K rows)
+* where V2 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
+ LASTC = ILAZLC( LASTV, N, C, LDC )
+*
+* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
+*
+* W := C2**H
+*
+ DO 70 J = 1, K
+ CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
+ 70 CONTINUE
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1**H*V1
+*
+ CALL ZGEMM( 'Conjugate transpose', 'No transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C, LDC, V, LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - V1 * W**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTV-K, LASTC, K,
+ $ -ONE, V, LDV, WORK, LDWORK,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**H
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**H
+*
+ DO 90 J = 1, K
+ DO 80 I = 1, LASTC
+ C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
+ $ DCONJG( WORK( I, J ) )
+ 80 CONTINUE
+ 90 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
+ LASTC = ILAZLR( M, LASTV, C, LDC )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C2
+*
+ DO 100 J = 1, K
+ CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ $ WORK( 1, J ), 1 )
+ 100 CONTINUE
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1 * V1
+*
+ CALL ZGEMM( 'No transpose', 'No transpose',
+ $ LASTC, K, LASTV-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - W * V1**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2**H
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W
+*
+ DO 120 J = 1, K
+ DO 110 I = 1, LASTC
+ C( I, LASTV-K+J ) = C( I, LASTV-K+J )
+ $ - WORK( I, J )
+ 110 CONTINUE
+ 120 CONTINUE
+ END IF
+ END IF
+*
+ ELSE IF( LSAME( STOREV, 'R' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 V2 ) (V1: first K columns)
+* where V1 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
+ LASTC = ILAZLC( LASTV, N, C, LDC )
+*
+* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
+*
+* W := C1**H
+*
+ DO 130 J = 1, K
+ CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
+ 130 CONTINUE
+*
+* W := W * V1**H
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2**H*V2**H
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTC, K, LASTV-K,
+ $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**H * W**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - V2**H * W**H
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTV-K, LASTC, K,
+ $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
+ $ ONE, C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W**H
+*
+ DO 150 J = 1, K
+ DO 140 I = 1, LASTC
+ C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
+ 140 CONTINUE
+ 150 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
+ LASTC = ILAZLR( M, LASTV, C, LDC )
+*
+* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
+*
+* W := C1
+*
+ DO 160 J = 1, K
+ CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 160 CONTINUE
+*
+* W := W * V1**H
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C2 * V2**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC,
+ $ V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C2 := C2 - W * V2
+*
+ CALL ZGEMM( 'No transpose', 'No transpose',
+ $ LASTC, LASTV-K, K,
+ $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
+ $ ONE, C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 180 J = 1, K
+ DO 170 I = 1, LASTC
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 170 CONTINUE
+ 180 CONTINUE
+*
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 V2 ) (V2: last K columns)
+* where V2 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H**H * C where C = ( C1 )
+* ( C2 )
+*
+ LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
+ LASTC = ILAZLC( LASTV, N, C, LDC )
+*
+* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
+*
+* W := C2**H
+*
+ DO 190 J = 1, K
+ CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ $ WORK( 1, J ), 1 )
+ CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
+ 190 CONTINUE
+*
+* W := W * V2**H
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1**H * V1**H
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTC, K, LASTV-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T**H or W * T
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V**H * W**H
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - V1**H * W**H
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', LASTV-K, LASTC, K,
+ $ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C2 := C2 - W**H
+*
+ DO 210 J = 1, K
+ DO 200 I = 1, LASTC
+ C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
+ $ DCONJG( WORK( I, J ) )
+ 200 CONTINUE
+ 210 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H**H where C = ( C1 C2 )
+*
+ LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
+ LASTC = ILAZLR( M, LASTV, C, LDC )
+*
+* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
+*
+* W := C2
+*
+ DO 220 J = 1, K
+ CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ $ WORK( 1, J ), 1 )
+ 220 CONTINUE
+*
+* W := W * V2**H
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+ IF( LASTV.GT.K ) THEN
+*
+* W := W + C1 * V1**H
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
+ $ WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T**H
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+ $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( LASTV.GT.K ) THEN
+*
+* C1 := C1 - W * V1
+*
+ CALL ZGEMM( 'No transpose', 'No transpose',
+ $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+ $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 240 J = 1, K
+ DO 230 I = 1, LASTC
+ C( I, LASTV-K+J ) = C( I, LASTV-K+J )
+ $ - WORK( I, J )
+ 230 CONTINUE
+ 240 CONTINUE
+*
+ END IF
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZLARFB
+*
+ END
diff --git a/lapack/zlarfg.f b/lapack/zlarfg.f
new file mode 100644
index 0000000..a90ae9f
--- /dev/null
+++ b/lapack/zlarfg.f
@@ -0,0 +1,203 @@
+*> \brief \b ZLARFG
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARFG + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarfg.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarfg.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarfg.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
+*
+* .. Scalar Arguments ..
+* INTEGER INCX, N
+* COMPLEX*16 ALPHA, TAU
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 X( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLARFG generates a complex elementary reflector H of order n, such
+*> that
+*>
+*> H**H * ( alpha ) = ( beta ), H**H * H = I.
+*> ( x ) ( 0 )
+*>
+*> where alpha and beta are scalars, with beta real, and x is an
+*> (n-1)-element complex vector. H is represented in the form
+*>
+*> H = I - tau * ( 1 ) * ( 1 v**H ) ,
+*> ( v )
+*>
+*> where tau is a complex scalar and v is a complex (n-1)-element
+*> vector. Note that H is not hermitian.
+*>
+*> If the elements of x are all zero and alpha is real, then tau = 0
+*> and H is taken to be the unit matrix.
+*>
+*> Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 .
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the elementary reflector.
+*> \endverbatim
+*>
+*> \param[in,out] ALPHA
+*> \verbatim
+*> ALPHA is COMPLEX*16
+*> On entry, the value alpha.
+*> On exit, it is overwritten with the value beta.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*> X is COMPLEX*16 array, dimension
+*> (1+(N-2)*abs(INCX))
+*> On entry, the vector x.
+*> On exit, it is overwritten with the vector v.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> The increment between elements of X. INCX > 0.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX*16
+*> The value tau.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex16OTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ COMPLEX*16 ALPHA, TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 X( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER J, KNT
+ DOUBLE PRECISION ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH, DLAPY3, DZNRM2
+ COMPLEX*16 ZLADIV
+ EXTERNAL DLAMCH, DLAPY3, DZNRM2, ZLADIV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DCMPLX, DIMAG, SIGN
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZDSCAL, ZSCAL
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.0 ) THEN
+ TAU = ZERO
+ RETURN
+ END IF
+*
+ XNORM = DZNRM2( N-1, X, INCX )
+ ALPHR = DBLE( ALPHA )
+ ALPHI = DIMAG( ALPHA )
+*
+ IF( XNORM.EQ.ZERO .AND. ALPHI.EQ.ZERO ) THEN
+*
+* H = I
+*
+ TAU = ZERO
+ ELSE
+*
+* general case
+*
+ BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
+ RSAFMN = ONE / SAFMIN
+*
+ KNT = 0
+ IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+* XNORM, BETA may be inaccurate; scale X and recompute them
+*
+ 10 CONTINUE
+ KNT = KNT + 1
+ CALL ZDSCAL( N-1, RSAFMN, X, INCX )
+ BETA = BETA*RSAFMN
+ ALPHI = ALPHI*RSAFMN
+ ALPHR = ALPHR*RSAFMN
+ IF( ABS( BETA ).LT.SAFMIN )
+ $ GO TO 10
+*
+* New BETA is at most 1, at least SAFMIN
+*
+ XNORM = DZNRM2( N-1, X, INCX )
+ ALPHA = DCMPLX( ALPHR, ALPHI )
+ BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ END IF
+ TAU = DCMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
+ ALPHA = ZLADIV( DCMPLX( ONE ), ALPHA-BETA )
+ CALL ZSCAL( N-1, ALPHA, X, INCX )
+*
+* If ALPHA is subnormal, it may lose relative accuracy
+*
+ DO 20 J = 1, KNT
+ BETA = BETA*SAFMIN
+ 20 CONTINUE
+ ALPHA = BETA
+ END IF
+*
+ RETURN
+*
+* End of ZLARFG
+*
+ END
diff --git a/lapack/zlarft.f b/lapack/zlarft.f
new file mode 100644
index 0000000..6a6151f
--- /dev/null
+++ b/lapack/zlarft.f
@@ -0,0 +1,327 @@
+*> \brief \b ZLARFT
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLARFT + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarft.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarft.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarft.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* .. Scalar Arguments ..
+* CHARACTER DIRECT, STOREV
+* INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLARFT forms the triangular factor T of a complex block reflector H
+*> of order n, which is defined as a product of k elementary reflectors.
+*>
+*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+*>
+*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+*>
+*> If STOREV = 'C', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th column of the array V, and
+*>
+*> H = I - V * T * V**H
+*>
+*> If STOREV = 'R', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th row of the array V, and
+*>
+*> H = I - V**H * T * V
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] DIRECT
+*> \verbatim
+*> DIRECT is CHARACTER*1
+*> Specifies the order in which the elementary reflectors are
+*> multiplied to form the block reflector:
+*> = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*> = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*> STOREV is CHARACTER*1
+*> Specifies how the vectors which define the elementary
+*> reflectors are stored (see also Further Details):
+*> = 'C': columnwise
+*> = 'R': rowwise
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the block reflector H. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> The order of the triangular factor T (= the number of
+*> elementary reflectors). K >= 1.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*> V is COMPLEX*16 array, dimension
+*> (LDV,K) if STOREV = 'C'
+*> (LDV,N) if STOREV = 'R'
+*> The matrix V. See further details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*> LDV is INTEGER
+*> The leading dimension of the array V.
+*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*> TAU is COMPLEX*16 array, dimension (K)
+*> TAU(i) must contain the scalar factor of the elementary
+*> reflector H(i).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*> T is COMPLEX*16 array, dimension (LDT,K)
+*> The k by k triangular factor T of the block reflector.
+*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+*> lower triangular. The rest of the array is not used.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*> LDT is INTEGER
+*> The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date April 2012
+*
+*> \ingroup complex16OTHERauxiliary
+*
+*> \par Further Details:
+* =====================
+*>
+*> \verbatim
+*>
+*> The shape of the matrix V and the storage of the vectors which define
+*> the H(i) is best illustrated by the following example with n = 5 and
+*> k = 3. The elements equal to 1 are not stored.
+*>
+*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*>
+*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+*> ( v1 1 ) ( 1 v2 v2 v2 )
+*> ( v1 v2 1 ) ( 1 v3 v3 )
+*> ( v1 v2 v3 )
+*> ( v1 v2 v3 )
+*>
+*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*>
+*> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+*> ( v1 v2 v3 ) ( v2 v2 v2 1 )
+*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+*> ( 1 v3 )
+*> ( 1 )
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* -- LAPACK auxiliary routine (version 3.4.1) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* April 2012
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, STOREV
+ INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE, ZERO
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
+ $ ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J, PREVLASTV, LASTV
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGEMV, ZLACGV, ZTRMV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+ PREVLASTV = N
+ DO I = 1, K
+ PREVLASTV = MAX( PREVLASTV, I )
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO J = 1, I
+ T( J, I ) = ZERO
+ END DO
+ ELSE
+*
+* general case
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+* Skip any trailing zeros.
+ DO LASTV = N, I+1, -1
+ IF( V( LASTV, I ).NE.ZERO ) EXIT
+ END DO
+ DO J = 1, I-1
+ T( J, I ) = -TAU( I ) * CONJG( V( I , J ) )
+ END DO
+ J = MIN( LASTV, PREVLASTV )
+*
+* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**H * V(i:j,i)
+*
+ CALL ZGEMV( 'Conjugate transpose', J-I, I-1,
+ $ -TAU( I ), V( I+1, 1 ), LDV,
+ $ V( I+1, I ), 1, ONE, T( 1, I ), 1 )
+ ELSE
+* Skip any trailing zeros.
+ DO LASTV = N, I+1, -1
+ IF( V( I, LASTV ).NE.ZERO ) EXIT
+ END DO
+ DO J = 1, I-1
+ T( J, I ) = -TAU( I ) * V( J , I )
+ END DO
+ J = MIN( LASTV, PREVLASTV )
+*
+* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**H
+*
+ CALL ZGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ),
+ $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV,
+ $ ONE, T( 1, I ), LDT )
+ END IF
+*
+* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
+*
+ CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
+ $ LDT, T( 1, I ), 1 )
+ T( I, I ) = TAU( I )
+ IF( I.GT.1 ) THEN
+ PREVLASTV = MAX( PREVLASTV, LASTV )
+ ELSE
+ PREVLASTV = LASTV
+ END IF
+ END IF
+ END DO
+ ELSE
+ PREVLASTV = 1
+ DO I = K, 1, -1
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO J = I, K
+ T( J, I ) = ZERO
+ END DO
+ ELSE
+*
+* general case
+*
+ IF( I.LT.K ) THEN
+ IF( LSAME( STOREV, 'C' ) ) THEN
+* Skip any leading zeros.
+ DO LASTV = 1, I-1
+ IF( V( LASTV, I ).NE.ZERO ) EXIT
+ END DO
+ DO J = I+1, K
+ T( J, I ) = -TAU( I ) * CONJG( V( N-K+I , J ) )
+ END DO
+ J = MAX( LASTV, PREVLASTV )
+*
+* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**H * V(j:n-k+i,i)
+*
+ CALL ZGEMV( 'Conjugate transpose', N-K+I-J, K-I,
+ $ -TAU( I ), V( J, I+1 ), LDV, V( J, I ),
+ $ 1, ONE, T( I+1, I ), 1 )
+ ELSE
+* Skip any leading zeros.
+ DO LASTV = 1, I-1
+ IF( V( I, LASTV ).NE.ZERO ) EXIT
+ END DO
+ DO J = I+1, K
+ T( J, I ) = -TAU( I ) * V( J, N-K+I )
+ END DO
+ J = MAX( LASTV, PREVLASTV )
+*
+* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H
+*
+ CALL ZGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ),
+ $ V( I+1, J ), LDV, V( I, J ), LDV,
+ $ ONE, T( I+1, I ), LDT )
+ END IF
+*
+* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
+*
+ CALL ZTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
+ $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
+ IF( I.GT.1 ) THEN
+ PREVLASTV = MIN( PREVLASTV, LASTV )
+ ELSE
+ PREVLASTV = LASTV
+ END IF
+ END IF
+ T( I, I ) = TAU( I )
+ END IF
+ END DO
+ END IF
+ RETURN
+*
+* End of ZLARFT
+*
+ END