added lapack-3.6.0

exports/gensymbol

@@ -173,18 +173,18 @@
 		sgbbrd, sgbcon, sgbequ, sgbrfs, sgbsv,
 		sgbsvx, sgbtf2, sgbtrf, sgbtrs, sgebak, sgebal, sgebd2,
 		sgebrd, sgecon, sgeequ, sgees,  sgeesx, sgeev,  sgeevx,
-		sgegs,  sgegv,  sgehd2, sgehrd, sgelq2, sgelqf,
-		sgels,  sgelsd, sgelss, sgelsx, sgelsy, sgeql2, sgeqlf,
-		sgeqp3, sgeqpf, sgeqr2, sgeqr2p, sgeqrf, sgeqrfp, sgerfs,
+		sgehd2, sgehrd, sgelq2, sgelqf,
+		sgels,  sgelsd, sgelss, sgelsy, sgeql2, sgeqlf,
+		sgeqp3, sgeqr2, sgeqr2p, sgeqrf, sgeqrfp, sgerfs,
 		sgerq2, sgerqf, sgesc2, sgesdd, sgesvd, sgesvx,
 		sgetc2, sgetri,
 		sggbak, sggbal, sgges,  sggesx, sggev,  sggevx,
 		sggglm, sgghrd, sgglse, sggqrf,
-		sggrqf, sggsvd, sggsvp, sgtcon, sgtrfs, sgtsv,
+		sggrqf, sgtcon, sgtrfs, sgtsv,
 		sgtsvx, sgttrf, sgttrs, sgtts2, shgeqz,
 		shsein, shseqr, slabrd, slacon, slacn2,
 		slaein, slaexc, slag2,  slags2, slagtm, slagv2, slahqr,
-		slahrd, slahr2, slaic1, slaln2, slals0, slalsa, slalsd,
+		slahr2, slaic1, slaln2, slals0, slalsa, slalsd,
 		slangb, slange, slangt, slanhs, slansb, slansp,
 		slansy, slantb, slantp, slantr, slanv2,
 		slapll, slapmt,
@@ -194,7 +194,7 @@
 		slarf,  slarfb, slarfg, slarfgp, slarft, slarfx, slargv,
 		slarrv, slartv,
 		slarz,  slarzb, slarzt, slasy2, slasyf,
-		slatbs, slatdf, slatps, slatrd, slatrs, slatrz, slatzm,
+		slatbs, slatdf, slatps, slatrd, slatrs, slatrz,
 		sopgtr, sopmtr, sorg2l, sorg2r,
 		sorgbr, sorghr, sorgl2, sorglq, sorgql, sorgqr, sorgr2,
 		sorgrq, sorgtr, sorm2l, sorm2r,
@@ -220,7 +220,7 @@
 		stgsja, stgsna, stgsy2, stgsyl, stpcon, stprfs, stptri,
 		stptrs,
 		strcon, strevc, strexc, strrfs, strsen, strsna, strsyl,
-		strtrs, stzrqf, stzrzf, sstemr,
+		strtrs, stzrzf, sstemr,
 		slansf, spftrf, spftri, spftrs, ssfrk, stfsm, stftri, stfttp,
 		stfttr, stpttf, stpttr, strttf, strttp,
 		sgejsv,  sgesvj,  sgsvj0,  sgsvj1,
@@ -245,14 +245,13 @@
 		cbdsqr, cgbbrd, cgbcon, cgbequ, cgbrfs, cgbsv,  cgbsvx,
 		cgbtf2, cgbtrf, cgbtrs, cgebak, cgebal, cgebd2, cgebrd,
 		cgecon, cgeequ, cgees,  cgeesx, cgeev,  cgeevx,
-		cgegs,  cgegv,  cgehd2, cgehrd, cgelq2, cgelqf,
-		cgels,  cgelsd, cgelss, cgelsx, cgelsy, cgeql2, cgeqlf, cgeqp3,
-		cgeqpf, cgeqr2, cgeqr2p, cgeqrf, cgeqrfp, cgerfs,
+		cgehd2, cgehrd, cgelq2, cgelqf,
+		cgels,  cgelsd, cgelss, cgelsy, cgeql2, cgeqlf, cgeqp3,
+		cgeqr2, cgeqr2p, cgeqrf, cgeqrfp, cgerfs,
 		cgerq2, cgerqf, cgesc2, cgesdd, cgesvd,
 		cgesvx, cgetc2, cgetri,
 		cggbak, cggbal, cgges,  cggesx, cggev,  cggevx, cggglm,
 		cgghrd, cgglse, cggqrf, cggrqf,
-		cggsvd, cggsvp,
 		cgtcon, cgtrfs, cgtsv,  cgtsvx, cgttrf, cgttrs, cgtts2, chbev,
 		chbevd, chbevx, chbgst, chbgv,  chbgvd, chbgvx, chbtrd,
 		checon, cheev,  cheevd, cheevr, cheevx, chegs2, chegst,
@@ -267,7 +266,7 @@
 		claed0, claed7, claed8,
 		claein, claesy, claev2, clags2, clagtm,
 		clahef, clahqr,
-		clahrd, clahr2, claic1, clals0, clalsa, clalsd, clangb, clange, clangt,
+		clahr2, claic1, clals0, clalsa, clalsd, clangb, clange, clangt,
 		clanhb, clanhe,
 		clanhp, clanhs, clanht, clansb, clansp, clansy, clantb,
 		clantp, clantr, clapll, clapmt, clarcm, claqgb, claqge,
@@ -278,7 +277,7 @@
 		clarfx, clargv, clarnv, clarrv, clartg, clartv,
 		clarz,  clarzb, clarzt, clascl, claset, clasr,  classq,
 		clasyf, clatbs, clatdf, clatps, clatrd, clatrs, clatrz,
-		clatzm, cpbcon, cpbequ, cpbrfs, cpbstf, cpbsv,
+		cpbcon, cpbequ, cpbrfs, cpbstf, cpbsv,
 		cpbsvx, cpbtf2, cpbtrf, cpbtrs, cpocon, cpoequ, cporfs,
 		cposv,  cposvx, cpstrf, cpstf2,
 		cppcon, cppequ, cpprfs, cppsv,  cppsvx, cpptrf, cpptri, cpptrs,
@@ -293,7 +292,7 @@
 		ctgexc, ctgsen, ctgsja, ctgsna, ctgsy2, ctgsyl, ctpcon,
 		ctprfs, ctptri,
 		ctptrs, ctrcon, ctrevc, ctrexc, ctrrfs, ctrsen, ctrsna,
-		ctrsyl, ctrtrs, ctzrqf, ctzrzf, cung2l, cung2r,
+		ctrsyl, ctrtrs, ctzrzf, cung2l, cung2r,
 		cungbr, cunghr, cungl2, cunglq, cungql, cungqr, cungr2,
 		cungrq, cungtr, cunm2l, cunm2r, cunmbr, cunmhr, cunml2,
 		cunmlq, cunmql, cunmqr, cunmr2, cunmr3, cunmrq, cunmrz,
@@ -321,18 +320,18 @@
 		dgbbrd, dgbcon, dgbequ, dgbrfs, dgbsv,
 		dgbsvx, dgbtf2, dgbtrf, dgbtrs, dgebak, dgebal, dgebd2,
 		dgebrd, dgecon, dgeequ, dgees,  dgeesx, dgeev,  dgeevx,
-		dgegs,  dgegv,  dgehd2, dgehrd, dgelq2, dgelqf,
-		dgels,  dgelsd, dgelss, dgelsx, dgelsy, dgeql2, dgeqlf,
-		dgeqp3, dgeqpf, dgeqr2, dgeqr2p, dgeqrf, dgeqrfp, dgerfs,
+		dgehd2, dgehrd, dgelq2, dgelqf,
+		dgels,  dgelsd, dgelss, dgelsy, dgeql2, dgeqlf,
+		dgeqp3, dgeqr2, dgeqr2p, dgeqrf, dgeqrfp, dgerfs,
 		dgerq2, dgerqf, dgesc2, dgesdd, dgesvd, dgesvx,
 		dgetc2, dgetri,
 		dggbak, dggbal, dgges,  dggesx, dggev,  dggevx,
 		dggglm, dgghrd, dgglse, dggqrf,
-		dggrqf, dggsvd, dggsvp, dgtcon, dgtrfs, dgtsv,
+		dggrqf, dgtcon, dgtrfs, dgtsv,
 		dgtsvx, dgttrf, dgttrs, dgtts2, dhgeqz,
 		dhsein, dhseqr, dlabrd, dlacon, dlacn2,
 		dlaein, dlaexc, dlag2,  dlags2, dlagtm, dlagv2, dlahqr,
-		dlahrd, dlahr2, dlaic1, dlaln2, dlals0, dlalsa, dlalsd,
+		dlahr2, dlaic1, dlaln2, dlals0, dlalsa, dlalsd,
 		dlangb, dlange, dlangt, dlanhs, dlansb, dlansp,
 		dlansy, dlantb, dlantp, dlantr, dlanv2,
 		dlapll, dlapmt,
@@ -342,7 +341,7 @@
 		dlarf,  dlarfb, dlarfg, dlarfgp, dlarft, dlarfx,
 		dlargv, dlarrv, dlartv,
 		dlarz,  dlarzb, dlarzt, dlasy2, dlasyf,
-		dlatbs, dlatdf, dlatps, dlatrd, dlatrs, dlatrz, dlatzm,
+		dlatbs, dlatdf, dlatps, dlatrd, dlatrs, dlatrz,
 		dopgtr, dopmtr, dorg2l, dorg2r,
 		dorgbr, dorghr, dorgl2, dorglq, dorgql, dorgqr, dorgr2,
 		dorgrq, dorgtr, dorm2l, dorm2r,
@@ -368,7 +367,7 @@
 		dtgsja, dtgsna, dtgsy2, dtgsyl, dtpcon, dtprfs, dtptri,
 		dtptrs,
 		dtrcon, dtrevc, dtrexc, dtrrfs, dtrsen, dtrsna, dtrsyl,
-		dtrtrs, dtzrqf, dtzrzf, dstemr,
+		dtrtrs, dtzrzf, dstemr,
 		dsgesv, dsposv, dlag2s, slag2d, dlat2s,
 		dlansf, dpftrf, dpftri, dpftrs, dsfrk, dtfsm, dtftri, dtfttp,
 		dtfttr, dtpttf, dtpttr, dtrttf, dtrttp,
@@ -387,14 +386,13 @@
 		zbdsqr, zgbbrd, zgbcon, zgbequ, zgbrfs, zgbsv,  zgbsvx,
 		zgbtf2, zgbtrf, zgbtrs, zgebak, zgebal, zgebd2, zgebrd,
 		zgecon, zgeequ, zgees,  zgeesx, zgeev,  zgeevx,
-		zgegs,  zgegv,  zgehd2, zgehrd, zgelq2, zgelqf,
-		zgels,  zgelsd, zgelss, zgelsx, zgelsy, zgeql2, zgeqlf, zgeqp3,
-		zgeqpf, zgeqr2, zgeqr2p, zgeqrf, zgeqrfp, zgerfs, zgerq2, zgerqf,
+		zgehd2, zgehrd, zgelq2, zgelqf,
+		zgels,  zgelsd, zgelss, zgelsy, zgeql2, zgeqlf, zgeqp3,
+		zgeqr2, zgeqr2p, zgeqrf, zgeqrfp, zgerfs, zgerq2, zgerqf,
 		zgesc2, zgesdd, zgesvd, zgesvx, zgetc2,
 		zgetri,
 		zggbak, zggbal, zgges,  zggesx, zggev,  zggevx, zggglm,
 		zgghrd, zgglse, zggqrf, zggrqf,
-		zggsvd, zggsvp,
 		zgtcon, zgtrfs, zgtsv,  zgtsvx, zgttrf, zgttrs, zgtts2, zhbev,
 		zhbevd, zhbevx, zhbgst, zhbgv,  zhbgvd, zhbgvx, zhbtrd,
 		zhecon, zheev,  zheevd, zheevr, zheevx, zhegs2, zhegst,
@@ -409,7 +407,7 @@
 		zlaed0, zlaed7, zlaed8,
 		zlaein, zlaesy, zlaev2, zlags2, zlagtm,
 		zlahef, zlahqr,
-		zlahrd, zlahr2, zlaic1, zlals0, zlalsa, zlalsd, zlangb, zlange,
+		zlahr2, zlaic1, zlals0, zlalsa, zlalsd, zlangb, zlange,
 		zlangt, zlanhb,
 		zlanhe,
 		zlanhp, zlanhs, zlanht, zlansb, zlansp, zlansy, zlantb,
@@ -422,7 +420,7 @@
 		zlarfx, zlargv, zlarnv, zlarrv, zlartg, zlartv,
 		zlarz,  zlarzb, zlarzt, zlascl, zlaset, zlasr,
 		zlassq, zlasyf,
-		zlatbs, zlatdf, zlatps, zlatrd, zlatrs, zlatrz, zlatzm,
+		zlatbs, zlatdf, zlatps, zlatrd, zlatrs, zlatrz, 
 		zpbcon, zpbequ, zpbrfs, zpbstf, zpbsv,
 		zpbsvx, zpbtf2, zpbtrf, zpbtrs, zpocon, zpoequ, zporfs,
 		zposv,  zposvx, zpotrs, zpstrf, zpstf2,
@@ -438,7 +436,7 @@
 		ztgexc, ztgsen, ztgsja, ztgsna, ztgsy2, ztgsyl, ztpcon,
 		ztprfs, ztptri,
 		ztptrs, ztrcon, ztrevc, ztrexc, ztrrfs, ztrsen, ztrsna,
-		ztrsyl, ztrtrs, ztzrqf, ztzrzf, zung2l,
+		ztrsyl, ztrtrs, ztzrzf, zung2l,
 		zung2r, zungbr, zunghr, zungl2, zunglq, zungql, zungqr, zungr2,
 		zungrq, zungtr, zunm2l, zunm2r, zunmbr, zunmhr, zunml2,
 		zunmlq, zunmql, zunmqr, zunmr2, zunmr3, zunmrq, zunmrz,
@@ -452,6 +450,140 @@
                 zunbdb5, zunbdb6, zuncsd, zuncsd2by1,
 		zgeqrt, zgeqrt2, zgeqrt3, zgemqrt,
 		ztpqrt, ztpqrt2, ztpmqrt, ztprfb,
+		# functions added for lapack-3.6.0
+
+		cgejsv,
+		cgesvdx,
+		cgesvj,
+		cgetrf2,
+		cgges3,
+		cggev3,
+		cgghd3,
+		cggsvd3,
+		cggsvp3,
+		cgsvj0,
+		cgsvj1,
+		clagge,
+		claghe,
+		clagsy,
+		clahilb,
+		clakf2,
+		clarge,
+		clarnd,
+		claror,
+		clarot,
+		clatm1,
+		clatm2,
+		clatm3,
+		clatm5,
+		clatm6,
+		clatme,
+		clatmr,
+		clatms,
+		clatmt,
+		cpotrf2,
+		csbmv,
+		cspr2,
+		csyr2,
+		cunm22,
+		dbdsvdx,
+		dgesvdx,
+		dgetrf2,
+		dgges3,
+		dggev3,
+		dgghd3,
+		dggsvd3,
+		dggsvp3,
+		dladiv2,
+		dlagge,
+		dlagsy,
+		dlahilb,
+		dlakf2,
+		dlaran,
+		dlarge,
+		dlarnd,
+		dlaror,
+		dlarot,
+		dlatm1,
+		dlatm2,
+		dlatm3,
+		dlatm5,
+		dlatm6,
+		dlatm7,
+		dlatme,
+		dlatmr,
+		dlatms,
+		dlatmt,
+		dorm22,
+		dpotrf2,
+		dsecnd,
+		sbdsvdx,
+		second,
+		sgesvdx,
+		sgetrf2,
+		sgges3,
+		sggev3,
+		sgghd3,
+		sggsvd3,
+		sggsvp3,
+		sladiv2,
+		slagge,
+		slagsy,
+		slahilb,
+		slakf2,
+		slaran,
+		slarge,
+		slarnd,
+		slaror,
+		slarot,
+		slatm1,
+		slatm2,
+		slatm3,
+		slatm5,
+		slatm6,
+		slatm7,
+		slatme,
+		slatmr,
+		slatms,
+		slatmt,
+		sorm22,
+		spotrf2,
+		xerbla,
+		zgejsv,
+		zgesvdx,
+		zgesvj,
+		zgetrf2,
+		zgges3,
+		zggev3,
+		zgghd3,
+		zggsvd3,
+		zggsvp3,
+		zgsvj0,
+		zgsvj1,
+		zlagge,
+		zlaghe,
+		zlagsy,
+		zlahilb,
+		zlakf2,
+		zlarge,
+		zlarnd,
+		zlaror,
+		zlarot,
+		zlatm1,
+		zlatm2,
+		zlatm3,
+		zlatm5,
+		zlatm6,
+		zlatme,
+		zlatmr,
+		zlatms,
+		zlatmt,
+		zpotrf2,
+		zsbmv,
+		zspr2,
+		zsyr2,
+		zunm22
+
 		);
 
 @lapack_extendedprecision_objs = (
@@ -682,8 +814,6 @@
     LAPACKE_cgeqlf_work,
     LAPACKE_cgeqp3,
     LAPACKE_cgeqp3_work,
-    LAPACKE_cgeqpf,
-    LAPACKE_cgeqpf_work,
     LAPACKE_cgeqr2,
     LAPACKE_cgeqr2_work,
     LAPACKE_cgeqrf,
@@ -738,10 +868,6 @@
     LAPACKE_cggqrf_work,
     LAPACKE_cggrqf,
     LAPACKE_cggrqf_work,
-    LAPACKE_cggsvd,
-    LAPACKE_cggsvd_work,
-    LAPACKE_cggsvp,
-    LAPACKE_cggsvp_work,
     LAPACKE_cgtcon,
     LAPACKE_cgtcon_work,
     LAPACKE_cgtrfs,
@@ -1186,8 +1312,6 @@
     LAPACKE_dgeqlf_work,
     LAPACKE_dgeqp3,
     LAPACKE_dgeqp3_work,
-    LAPACKE_dgeqpf,
-    LAPACKE_dgeqpf_work,
     LAPACKE_dgeqr2,
     LAPACKE_dgeqr2_work,
     LAPACKE_dgeqrf,
@@ -1244,10 +1368,6 @@
     LAPACKE_dggqrf_work,
     LAPACKE_dggrqf,
     LAPACKE_dggrqf_work,
-    LAPACKE_dggsvd,
-    LAPACKE_dggsvd_work,
-    LAPACKE_dggsvp,
-    LAPACKE_dggsvp_work,
     LAPACKE_dgtcon,
     LAPACKE_dgtcon_work,
     LAPACKE_dgtrfs,
@@ -1676,8 +1796,6 @@
     LAPACKE_sgeqlf_work,
     LAPACKE_sgeqp3,
     LAPACKE_sgeqp3_work,
-    LAPACKE_sgeqpf,
-    LAPACKE_sgeqpf_work,
     LAPACKE_sgeqr2,
     LAPACKE_sgeqr2_work,
     LAPACKE_sgeqrf,
@@ -1734,10 +1852,6 @@
     LAPACKE_sggqrf_work,
     LAPACKE_sggrqf,
     LAPACKE_sggrqf_work,
-    LAPACKE_sggsvd,
-    LAPACKE_sggsvd_work,
-    LAPACKE_sggsvp,
-    LAPACKE_sggsvp_work,
     LAPACKE_sgtcon,
     LAPACKE_sgtcon_work,
     LAPACKE_sgtrfs,
@@ -2158,8 +2272,6 @@
     LAPACKE_zgeqlf_work,
     LAPACKE_zgeqp3,
     LAPACKE_zgeqp3_work,
-    LAPACKE_zgeqpf,
-    LAPACKE_zgeqpf_work,
     LAPACKE_zgeqr2,
     LAPACKE_zgeqr2_work,
     LAPACKE_zgeqrf,
@@ -2214,10 +2326,6 @@
     LAPACKE_zggqrf_work,
     LAPACKE_zggrqf,
     LAPACKE_zggrqf_work,
-    LAPACKE_zggsvd,
-    LAPACKE_zggsvd_work,
-    LAPACKE_zggsvp,
-    LAPACKE_zggsvp_work,
     LAPACKE_zgtcon,
     LAPACKE_zgtcon_work,
     LAPACKE_zgtrfs,
@@ -2707,6 +2815,134 @@
 		LAPACKE_slagsy_work,
 		LAPACKE_zlagsy,
 		LAPACKE_zlagsy_work,
+		## new function from lapack-3.6.0
+
+		LAPACKE_cgejsv,
+		LAPACKE_cgejsv_work,
+		LAPACKE_cgesvdx,
+		LAPACKE_cgesvdx_work,
+		LAPACKE_cgesvj,
+		LAPACKE_cgesvj_work,
+		LAPACKE_cgetrf2,
+		LAPACKE_cgetrf2_work,
+		LAPACKE_cgges3,
+		LAPACKE_cgges3_work,
+		LAPACKE_cggev3,
+		LAPACKE_cggev3_work,
+		LAPACKE_cgghd3,
+		LAPACKE_cgghd3_work,
+		LAPACKE_cggsvd3,
+		LAPACKE_cggsvd3_work,
+		LAPACKE_cggsvp3,
+		LAPACKE_cggsvp3_work,
+		LAPACKE_chetrf_rook,
+		LAPACKE_chetrf_rook_work,
+		LAPACKE_chetrs_rook,
+		LAPACKE_chetrs_rook_work,
+		LAPACKE_clapmt,
+		LAPACKE_clapmt_work,
+		LAPACKE_clascl,
+		LAPACKE_clascl_work,
+		LAPACKE_cpotrf2,
+		LAPACKE_cpotrf2_work,
+		LAPACKE_csytrf_rook,
+		LAPACKE_csytrf_rook_work,
+		LAPACKE_csytrs_rook,
+		LAPACKE_csytrs_rook_work,
+		LAPACKE_cuncsd2by1,
+		LAPACKE_cuncsd2by1_work,
+		LAPACKE_dbdsvdx,
+		LAPACKE_dbdsvdx_work,
+		LAPACKE_dgesvdx,
+		LAPACKE_dgesvdx_work,
+		LAPACKE_dgetrf2,
+		LAPACKE_dgetrf2_work,
+		LAPACKE_dgges3,
+		LAPACKE_dgges3_work,
+		LAPACKE_dggev3,
+		LAPACKE_dggev3_work,
+		LAPACKE_dgghd3,
+		LAPACKE_dgghd3_work,
+		LAPACKE_dggsvd3,
+		LAPACKE_dggsvd3_work,
+		LAPACKE_dggsvp3,
+		LAPACKE_dggsvp3_work,
+		LAPACKE_dlapmt,
+		LAPACKE_dlapmt_work,
+		LAPACKE_dlascl,
+		LAPACKE_dlascl_work,
+		LAPACKE_dorcsd2by1,
+		LAPACKE_dorcsd2by1_work,
+		LAPACKE_dpotrf2,
+		LAPACKE_dpotrf2_work,
+		LAPACKE_dsytrf_rook,
+		LAPACKE_dsytrf_rook_work,
+		LAPACKE_dsytrs_rook,
+		LAPACKE_dsytrs_rook_work,
+		LAPACKE_sbdsvdx,
+		LAPACKE_sbdsvdx_work,
+		LAPACKE_sgesvdx,
+		LAPACKE_sgesvdx_work,
+		LAPACKE_sgetrf2,
+		LAPACKE_sgetrf2_work,
+		LAPACKE_sgges3,
+		LAPACKE_sgges3_work,
+		LAPACKE_sggev3,
+		LAPACKE_sggev3_work,
+		LAPACKE_sgghd3,
+		LAPACKE_sgghd3_work,
+		LAPACKE_sggsvd3,
+		LAPACKE_sggsvd3_work,
+		LAPACKE_sggsvp3,
+		LAPACKE_sggsvp3_work,
+		LAPACKE_slapmt,
+		LAPACKE_slapmt_work,
+		LAPACKE_slascl,
+		LAPACKE_slascl_work,
+		LAPACKE_sorcsd2by1,
+		LAPACKE_sorcsd2by1_work,
+		LAPACKE_spotrf2,
+		LAPACKE_spotrf2_work,
+		LAPACKE_ssytrf_rook,
+		LAPACKE_ssytrf_rook_work,
+		LAPACKE_ssytrs_rook,
+		LAPACKE_ssytrs_rook_work,
+		LAPACKE_stpqrt,
+		LAPACKE_stpqrt_work,
+		LAPACKE_zgejsv,
+		LAPACKE_zgejsv_work,
+		LAPACKE_zgesvdx,
+		LAPACKE_zgesvdx_work,
+		LAPACKE_zgesvj,
+		LAPACKE_zgesvj_work,
+		LAPACKE_zgetrf2,
+		LAPACKE_zgetrf2_work,
+		LAPACKE_zgges3,
+		LAPACKE_zgges3_work,
+		LAPACKE_zggev3,
+		LAPACKE_zggev3_work,
+		LAPACKE_zgghd3,
+		LAPACKE_zgghd3_work,
+		LAPACKE_zggsvd3,
+		LAPACKE_zggsvd3_work,
+		LAPACKE_zggsvp3,
+		LAPACKE_zggsvp3_work,
+		LAPACKE_zhetrf_rook,
+		LAPACKE_zhetrf_rook_work,
+		LAPACKE_zhetrs_rook,
+		LAPACKE_zhetrs_rook_work,
+		LAPACKE_zlapmt,
+		LAPACKE_zlapmt_work,
+		LAPACKE_zlascl,
+		LAPACKE_zlascl_work,
+		LAPACKE_zpotrf2,
+		LAPACKE_zpotrf2_work,
+		LAPACKE_zsytrf_rook,
+		LAPACKE_zsytrf_rook_work,
+		LAPACKE_zsytrs_rook,
+		LAPACKE_zsytrs_rook_work,
+		LAPACKE_zuncsd2by1,
+		LAPACKE_zuncsd2by1_work
 		);
 
 #These function may need 2 underscores.

lapack-netlib/BLAS/CMakeLists.txt

@@ -0,0 +1,9 @@
+add_subdirectory(SRC)
+if(BUILD_TESTING)
+add_subdirectory(TESTING)
+endif(BUILD_TESTING)
+configure_file(${CMAKE_CURRENT_SOURCE_DIR}/blas.pc.in ${CMAKE_CURRENT_BINARY_DIR}/blas.pc)
+install(FILES
+  ${CMAKE_CURRENT_BINARY_DIR}/blas.pc
+  DESTINATION ${PKG_CONFIG_DIR}
+  )

lapack-netlib/BLAS/SRC/CMakeLists.txt

@@ -0,0 +1,149 @@
+#######################################################################
+#  This is the makefile to create a library for the BLAS.
+#  The files are grouped as follows:
+#
+#       SBLAS1 -- Single precision real BLAS routines
+#       CBLAS1 -- Single precision complex BLAS routines
+#       DBLAS1 -- Double precision real BLAS routines
+#       ZBLAS1 -- Double precision complex BLAS routines
+#
+#       CB1AUX -- Real BLAS routines called by complex routines
+#       ZB1AUX -- D.P. real BLAS routines called by d.p. complex
+#                 routines
+#
+#      ALLBLAS -- Auxiliary routines for Level 2 and 3 BLAS
+#
+#       SBLAS2 -- Single precision real BLAS2 routines
+#       CBLAS2 -- Single precision complex BLAS2 routines
+#       DBLAS2 -- Double precision real BLAS2 routines
+#       ZBLAS2 -- Double precision complex BLAS2 routines
+#
+#       SBLAS3 -- Single precision real BLAS3 routines
+#       CBLAS3 -- Single precision complex BLAS3 routines
+#       DBLAS3 -- Double precision real BLAS3 routines
+#       ZBLAS3 -- Double precision complex BLAS3 routines
+#
+#  The library can be set up to include routines for any combination
+#  of the four precisions.  To create or add to the library, enter make
+#  followed by one or more of the precisions desired.  Some examples:
+#       make single
+#       make single complex
+#       make single double complex complex16
+#  Note that these commands are not safe for parallel builds.
+#
+#  Alternatively, the commands
+#       make all
+#  or
+#       make
+#  without any arguments creates a library of all four precisions.
+#  The name of the library is held in BLASLIB, which is set in the
+#  top-level make.inc
+#
+#  To remove the object files after the library is created, enter
+#       make clean
+#  To force the source files to be recompiled, enter, for example,
+#       make single FRC=FRC
+#
+#---------------------------------------------------------------------
+#
+#  Edward Anderson, University of Tennessee
+#  March 26, 1990
+#  Susan Ostrouchov, Last updated September 30, 1994
+#  ejr, May 2006.
+#
+#######################################################################
+
+#---------------------------------------------------------
+#  Comment out the next 6 definitions if you already have
+#  the Level 1 BLAS.
+#---------------------------------------------------------
+set(SBLAS1 isamax.f sasum.f saxpy.f scopy.f sdot.f snrm2.f 
+	srot.f srotg.f sscal.f sswap.f sdsdot.f srotmg.f srotm.f)
+
+set(CBLAS1 scabs1.f scasum.f scnrm2.f icamax.f caxpy.f ccopy.f 
+	cdotc.f cdotu.f csscal.f crotg.f cscal.f cswap.f csrot.f)
+
+set(DBLAS1 idamax.f dasum.f daxpy.f dcopy.f ddot.f dnrm2.f 
+	drot.f drotg.f dscal.f dsdot.f dswap.f drotmg.f drotm.f)
+
+set(ZBLAS1 dcabs1.f dzasum.f dznrm2.f izamax.f zaxpy.f zcopy.f 
+	zdotc.f zdotu.f zdscal.f zrotg.f zscal.f zswap.f zdrot.f)
+
+set(CB1AUX  isamax.f sasum.f saxpy.f scopy.f snrm2.f sscal.f)
+
+set(ZB1AUX idamax.f dasum.f daxpy.f dcopy.f dnrm2.f dscal.f)
+
+#---------------------------------------------------------------------
+#  The following line defines auxiliary routines needed by both the
+#  Level 2 and Level 3 BLAS.  Comment it out only if you already have
+#  both the Level 2 and 3 BLAS.
+#---------------------------------------------------------------------
+set(ALLBLAS  lsame.f xerbla.f xerbla_array.f)
+
+#---------------------------------------------------------
+#  Comment out the next 4 definitions if you already have
+#  the Level 2 BLAS.
+#---------------------------------------------------------
+set(SBLAS2 sgemv.f sgbmv.f ssymv.f ssbmv.f sspmv.f 
+	strmv.f stbmv.f stpmv.f strsv.f stbsv.f stpsv.f 
+	sger.f ssyr.f sspr.f ssyr2.f sspr2.f)
+
+set(CBLAS2 cgemv.f cgbmv.f chemv.f chbmv.f chpmv.f 
+	ctrmv.f ctbmv.f ctpmv.f ctrsv.f ctbsv.f ctpsv.f 
+	cgerc.f cgeru.f cher.f chpr.f cher2.f chpr2.f)
+
+set(DBLAS2 dgemv.f dgbmv.f dsymv.f dsbmv.f dspmv.f 
+	dtrmv.f dtbmv.f dtpmv.f dtrsv.f dtbsv.f dtpsv.f 
+	dger.f dsyr.f dspr.f dsyr2.f dspr2.f)
+
+set(ZBLAS2 zgemv.f zgbmv.f zhemv.f zhbmv.f zhpmv.f 
+	ztrmv.f ztbmv.f ztpmv.f ztrsv.f ztbsv.f ztpsv.f 
+	zgerc.f zgeru.f zher.f zhpr.f zher2.f zhpr2.f)
+
+#---------------------------------------------------------
+#  Comment out the next 4 definitions if you already have
+#  the Level 3 BLAS.
+#---------------------------------------------------------
+set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f )
+
+set(CBLAS3 cgemm.f csymm.f csyrk.f csyr2k.f ctrmm.f ctrsm.f 
+	chemm.f cherk.f cher2k.f)
+
+set(DBLAS3 dgemm.f dsymm.f dsyrk.f dsyr2k.f dtrmm.f dtrsm.f)
+
+set(ZBLAS3 zgemm.f zsymm.f zsyrk.f zsyr2k.f ztrmm.f ztrsm.f 
+	zhemm.f zherk.f zher2k.f)
+# default build all of it
+set(ALLOBJ ${SBLAS1} ${SBLAS2} ${SBLAS3} ${DBLAS1} ${DBLAS2} ${DBLAS3}	
+	${CBLAS1} ${CBLAS2} ${CBLAS3} ${ZBLAS1} 
+	${ZBLAS2} ${ZBLAS3} ${ALLBLAS})
+
+if(BLAS_SINGLE)
+  set(ALLOBJ ${SBLAS1} ${ALLBLAS} 
+	${SBLAS2} ${SBLAS3})
+endif()
+if(BLAS_DOUBLE)
+  set(ALLOBJ ${DBLAS1} ${ALLBLAS} 
+	${DBLAS2} ${DBLAS3})
+endif()
+if(BLAS_COMPLEX)
+  set(ALLOBJ  ${BLASLIB} ${CBLAS1} ${CB1AUX} 
+	${ALLBLAS} ${CBLAS2})
+endif()
+if(BLAS_COMPLEX16)
+  set(ALLOBJ  ${BLASLIB} ${ZBLAS1} ${ZB1AUX} 
+	${ALLBLAS} ${ZBLAS2} ${ZBLAS3})
+endif()
+  
+  
+add_library(blas ${ALLOBJ})
+#if(UNIX)
+#  target_link_libraries(blas m)
+#endif()
+set_target_properties(
+  blas PROPERTIES
+  VERSION ${LAPACK_VERSION}
+  SOVERSION ${LAPACK_MAJOR_VERSION}
+  )
+target_link_libraries(blas)
+lapack_install_library(blas)

lapack-netlib/BLAS/SRC/Makefile

@@ -0,0 +1,171 @@
+include ../../make.inc
+
+#######################################################################
+#  This is the makefile to create a library for the BLAS.
+#  The files are grouped as follows:
+#
+#       SBLAS1 -- Single precision real BLAS routines
+#       CBLAS1 -- Single precision complex BLAS routines
+#       DBLAS1 -- Double precision real BLAS routines
+#       ZBLAS1 -- Double precision complex BLAS routines
+#
+#       CB1AUX -- Real BLAS routines called by complex routines
+#       ZB1AUX -- D.P. real BLAS routines called by d.p. complex
+#                 routines
+#
+#      ALLBLAS -- Auxiliary routines for Level 2 and 3 BLAS
+#
+#       SBLAS2 -- Single precision real BLAS2 routines
+#       CBLAS2 -- Single precision complex BLAS2 routines
+#       DBLAS2 -- Double precision real BLAS2 routines
+#       ZBLAS2 -- Double precision complex BLAS2 routines
+#
+#       SBLAS3 -- Single precision real BLAS3 routines
+#       CBLAS3 -- Single precision complex BLAS3 routines
+#       DBLAS3 -- Double precision real BLAS3 routines
+#       ZBLAS3 -- Double precision complex BLAS3 routines
+#
+#  The library can be set up to include routines for any combination
+#  of the four precisions.  To create or add to the library, enter make
+#  followed by one or more of the precisions desired.  Some examples:
+#       make single
+#       make single complex
+#       make single double complex complex16
+#  Note that these commands are not safe for parallel builds.
+#
+#  Alternatively, the commands
+#       make all
+#  or
+#       make
+#  without any arguments creates a library of all four precisions.
+#  The name of the library is held in BLASLIB, which is set in the
+#  top-level make.inc
+#
+#  To remove the object files after the library is created, enter
+#       make clean
+#  To force the source files to be recompiled, enter, for example,
+#       make single FRC=FRC
+#
+#---------------------------------------------------------------------
+#
+#  Edward Anderson, University of Tennessee
+#  March 26, 1990
+#  Susan Ostrouchov, Last updated September 30, 1994
+#  ejr, May 2006.
+#
+#######################################################################
+
+all: $(BLASLIB)
+ 
+#---------------------------------------------------------
+#  Comment out the next 6 definitions if you already have
+#  the Level 1 BLAS.
+#---------------------------------------------------------
+SBLAS1 = isamax.o sasum.o saxpy.o scopy.o sdot.o snrm2.o \
+	srot.o srotg.o sscal.o sswap.o sdsdot.o srotmg.o srotm.o
+$(SBLAS1): $(FRC)
+
+CBLAS1 = scabs1.o scasum.o scnrm2.o icamax.o caxpy.o ccopy.o \
+	cdotc.o cdotu.o csscal.o crotg.o cscal.o cswap.o csrot.o
+$(CBLAS1): $(FRC)
+
+DBLAS1 = idamax.o dasum.o daxpy.o dcopy.o ddot.o dnrm2.o \
+	drot.o drotg.o dscal.o dsdot.o dswap.o drotmg.o drotm.o
+$(DBLAS1): $(FRC)
+
+ZBLAS1 = dcabs1.o dzasum.o dznrm2.o izamax.o zaxpy.o zcopy.o \
+	zdotc.o zdotu.o zdscal.o zrotg.o zscal.o zswap.o zdrot.o
+$(ZBLAS1): $(FRC)
+
+CB1AUX = isamax.o sasum.o saxpy.o scopy.o snrm2.o sscal.o
+$(CB1AUX): $(FRC)
+
+ZB1AUX = idamax.o dasum.o daxpy.o dcopy.o dnrm2.o dscal.o
+$(ZB1AUX): $(FRC)
+
+#---------------------------------------------------------------------
+#  The following line defines auxiliary routines needed by both the
+#  Level 2 and Level 3 BLAS.  Comment it out only if you already have
+#  both the Level 2 and 3 BLAS.
+#---------------------------------------------------------------------
+ALLBLAS  = lsame.o xerbla.o xerbla_array.o
+$(ALLBLAS) : $(FRC)
+
+#---------------------------------------------------------
+#  Comment out the next 4 definitions if you already have
+#  the Level 2 BLAS.
+#---------------------------------------------------------
+SBLAS2 = sgemv.o sgbmv.o ssymv.o ssbmv.o sspmv.o \
+	strmv.o stbmv.o stpmv.o strsv.o stbsv.o stpsv.o \
+	sger.o ssyr.o sspr.o ssyr2.o sspr2.o
+$(SBLAS2): $(FRC)
+
+CBLAS2 = cgemv.o cgbmv.o chemv.o chbmv.o chpmv.o \
+	ctrmv.o ctbmv.o ctpmv.o ctrsv.o ctbsv.o ctpsv.o \
+	cgerc.o cgeru.o cher.o chpr.o cher2.o chpr2.o
+$(CBLAS2): $(FRC)
+
+DBLAS2 = dgemv.o dgbmv.o dsymv.o dsbmv.o dspmv.o \
+	dtrmv.o dtbmv.o dtpmv.o dtrsv.o dtbsv.o dtpsv.o \
+	dger.o dsyr.o dspr.o dsyr2.o dspr2.o
+$(DBLAS2): $(FRC)
+
+ZBLAS2 = zgemv.o zgbmv.o zhemv.o zhbmv.o zhpmv.o \
+	ztrmv.o ztbmv.o ztpmv.o ztrsv.o ztbsv.o ztpsv.o \
+	zgerc.o zgeru.o zher.o zhpr.o zher2.o zhpr2.o
+$(ZBLAS2): $(FRC)
+
+#---------------------------------------------------------
+#  Comment out the next 4 definitions if you already have
+#  the Level 3 BLAS.
+#---------------------------------------------------------
+SBLAS3 = sgemm.o ssymm.o ssyrk.o ssyr2k.o strmm.o strsm.o 
+$(SBLAS3): $(FRC)
+
+CBLAS3 = cgemm.o csymm.o csyrk.o csyr2k.o ctrmm.o ctrsm.o \
+	chemm.o cherk.o cher2k.o
+$(CBLAS3): $(FRC)
+
+DBLAS3 = dgemm.o dsymm.o dsyrk.o dsyr2k.o dtrmm.o dtrsm.o
+$(DBLAS3): $(FRC)
+
+ZBLAS3 = zgemm.o zsymm.o zsyrk.o zsyr2k.o ztrmm.o ztrsm.o \
+	zhemm.o zherk.o zher2k.o
+$(ZBLAS3): $(FRC)
+
+ALLOBJ=$(SBLAS1) $(SBLAS2) $(SBLAS3) $(DBLAS1) $(DBLAS2) $(DBLAS3)	\
+	$(CBLAS1) $(CBLAS2) $(CBLAS3) $(ZBLAS1) \
+	$(ZBLAS2) $(ZBLAS3) $(ALLBLAS)
+
+$(BLASLIB): $(ALLOBJ)
+	$(ARCH) $(ARCHFLAGS) $@ $(ALLOBJ)
+	$(RANLIB) $@
+
+single: $(SBLAS1) $(ALLBLAS) $(SBLAS2) $(SBLAS3)
+	$(ARCH) $(ARCHFLAGS) $(BLASLIB) $(SBLAS1) $(ALLBLAS) \
+	$(SBLAS2) $(SBLAS3)
+	$(RANLIB) $(BLASLIB)
+
+double: $(DBLAS1) $(ALLBLAS) $(DBLAS2) $(DBLAS3)
+	$(ARCH) $(ARCHFLAGS) $(BLASLIB) $(DBLAS1) $(ALLBLAS) \
+	$(DBLAS2) $(DBLAS3)
+	$(RANLIB) $(BLASLIB)
+
+complex: $(CBLAS1) $(CB1AUX) $(ALLBLAS) $(CBLAS2) $(CBLAS3)
+	$(ARCH) $(ARCHFLAGS) $(BLASLIB) $(CBLAS1) $(CB1AUX) \
+	$(ALLBLAS) $(CBLAS2) $(CBLAS3)
+	$(RANLIB) $(BLASLIB)
+
+complex16: $(ZBLAS1) $(ZB1AUX) $(ALLBLAS) $(ZBLAS2) $(ZBLAS3)
+	$(ARCH) $(ARCHFLAGS) $(BLASLIB) $(ZBLAS1) $(ZB1AUX) \
+	$(ALLBLAS) $(ZBLAS2) $(ZBLAS3)
+	$(RANLIB) $(BLASLIB)
+
+FRC:
+	@FRC=$(FRC)
+
+clean:
+	rm -f *.o
+
+.f.o: 
+	$(FORTRAN) $(OPTS) -c $< -o $@

lapack-netlib/BLAS/SRC/caxpy.f

@@ -0,0 +1,102 @@
+*> \brief \b CAXPY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX CA
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX CX(*),CY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    CAXPY constant times a vector plus a vector.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 CA
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*),CY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,IX,IY
+*     ..
+*     .. External Functions ..
+      REAL SCABS1
+      EXTERNAL SCABS1
+*     ..
+      IF (N.LE.0) RETURN
+      IF (SCABS1(CA).EQ.0.0E+0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+         DO I = 1,N
+            CY(I) = CY(I) + CA*CX(I)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            CY(IY) = CY(IY) + CA*CX(IX)
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+*
+      RETURN
+      END

lapack-netlib/BLAS/SRC/ccopy.f

@@ -0,0 +1,94 @@
+*> \brief \b CCOPY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CCOPY(N,CX,INCX,CY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX CX(*),CY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    CCOPY copies a vector x to a vector y.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CCOPY(N,CX,INCX,CY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*),CY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,IX,IY
+*     ..
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+         DO I = 1,N
+            CY(I) = CX(I)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            CY(IY) = CX(IX)
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/cdotc.f

@@ -0,0 +1,103 @@
+*> \brief \b CDOTC
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       COMPLEX FUNCTION CDOTC(N,CX,INCX,CY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX CX(*),CY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CDOTC forms the dot product of two complex vectors
+*>      CDOTC = X^H * Y
+*>
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup complex_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack,  3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      COMPLEX FUNCTION CDOTC(N,CX,INCX,CY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*),CY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      COMPLEX CTEMP
+      INTEGER I,IX,IY
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG
+*     ..
+      CTEMP = (0.0,0.0)
+      CDOTC = (0.0,0.0)
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+         DO I = 1,N
+            CTEMP = CTEMP + CONJG(CX(I))*CY(I)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            CTEMP = CTEMP + CONJG(CX(IX))*CY(IY)
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      CDOTC = CTEMP
+      RETURN
+      END

lapack-netlib/BLAS/SRC/cdotu.f

@@ -0,0 +1,100 @@
+*> \brief \b CDOTU
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX CX(*),CY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CDOTU forms the dot product of two complex vectors
+*>      CDOTU = X^T * Y
+*>
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup complex_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*),CY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      COMPLEX CTEMP
+      INTEGER I,IX,IY
+*     ..
+      CTEMP = (0.0,0.0)
+      CDOTU = (0.0,0.0)
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+         DO I = 1,N
+            CTEMP = CTEMP + CX(I)*CY(I)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            CTEMP = CTEMP + CX(IX)*CY(IY)
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      CDOTU = CTEMP
+      RETURN
+      END

lapack-netlib/BLAS/SRC/cgbmv.f

@@ -0,0 +1,390 @@
+*> \brief \b CGBMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER INCX,INCY,KL,KU,LDA,M,N
+*       CHARACTER TRANS
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CGBMV  performs one of the matrix-vector operations
+*>
+*>    y := alpha*A*x + beta*y,   or   y := alpha*A**T*x + beta*y,   or
+*>
+*>    y := alpha*A**H*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are vectors and A is an
+*> m by n band matrix, with kl sub-diagonals and ku super-diagonals.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*>
+*>              TRANS = 'T' or 't'   y := alpha*A**T*x + beta*y.
+*>
+*>              TRANS = 'C' or 'c'   y := alpha*A**H*x + beta*y.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] KL
+*> \verbatim
+*>          KL is INTEGER
+*>           On entry, KL specifies the number of sub-diagonals of the
+*>           matrix A. KL must satisfy  0 .le. KL.
+*> \endverbatim
+*>
+*> \param[in] KU
+*> \verbatim
+*>          KU is INTEGER
+*>           On entry, KU specifies the number of super-diagonals of the
+*>           matrix A. KU must satisfy  0 .le. KU.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading ( kl + ku + 1 ) by n part of the
+*>           array A must contain the matrix of coefficients, supplied
+*>           column by column, with the leading diagonal of the matrix in
+*>           row ( ku + 1 ) of the array, the first super-diagonal
+*>           starting at position 2 in row ku, the first sub-diagonal
+*>           starting at position 1 in row ( ku + 2 ), and so on.
+*>           Elements in the array A that do not correspond to elements
+*>           in the band matrix (such as the top left ku by ku triangle)
+*>           are not referenced.
+*>           The following program segment will transfer a band matrix
+*>           from conventional full matrix storage to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    K = KU + 1 - J
+*>                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
+*>                       A( K + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( kl + ku + 1 ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*>           Before entry, the incremented array X must contain the
+*>           vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is COMPLEX array of DIMENSION at least
+*>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*>           Before entry, the incremented array Y must contain the
+*>           vector y. On exit, Y is overwritten by the updated vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      COMPLEX ALPHA,BETA
+      INTEGER INCX,INCY,KL,KU,LDA,M,N
+      CHARACTER TRANS
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
+      LOGICAL NOCONJ
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,MIN
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +    .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 1
+      ELSE IF (M.LT.0) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (KL.LT.0) THEN
+          INFO = 4
+      ELSE IF (KU.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT. (KL+KU+1)) THEN
+          INFO = 8
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 10
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 13
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CGBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          LENX = N
+          LENY = M
+      ELSE
+          LENX = M
+          LENY = N
+      END IF
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (LENX-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (LENY-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the band part of A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,LENY
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,LENY
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,LENY
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,LENY
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      KUP1 = KU + 1
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+          JX = KX
+          IF (INCY.EQ.1) THEN
+              DO 60 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  K = KUP1 - J
+                  DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
+                      Y(I) = Y(I) + TEMP*A(K+I,J)
+   50             CONTINUE
+                  JX = JX + INCX
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  IY = KY
+                  K = KUP1 - J
+                  DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
+                      Y(IY) = Y(IY) + TEMP*A(K+I,J)
+                      IY = IY + INCY
+   70             CONTINUE
+                  JX = JX + INCX
+                  IF (J.GT.KU) KY = KY + INCY
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y := alpha*A**T*x + y  or  y := alpha*A**H*x + y.
+*
+          JY = KY
+          IF (INCX.EQ.1) THEN
+              DO 110 J = 1,N
+                  TEMP = ZERO
+                  K = KUP1 - J
+                  IF (NOCONJ) THEN
+                      DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
+                          TEMP = TEMP + A(K+I,J)*X(I)
+   90                 CONTINUE
+                  ELSE
+                      DO 100 I = MAX(1,J-KU),MIN(M,J+KL)
+                          TEMP = TEMP + CONJG(A(K+I,J))*X(I)
+  100                 CONTINUE
+                  END IF
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+  110         CONTINUE
+          ELSE
+              DO 140 J = 1,N
+                  TEMP = ZERO
+                  IX = KX
+                  K = KUP1 - J
+                  IF (NOCONJ) THEN
+                      DO 120 I = MAX(1,J-KU),MIN(M,J+KL)
+                          TEMP = TEMP + A(K+I,J)*X(IX)
+                          IX = IX + INCX
+  120                 CONTINUE
+                  ELSE
+                      DO 130 I = MAX(1,J-KU),MIN(M,J+KL)
+                          TEMP = TEMP + CONJG(A(K+I,J))*X(IX)
+                          IX = IX + INCX
+  130                 CONTINUE
+                  END IF
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+                  IF (J.GT.KU) KX = KX + INCX
+  140         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CGBMV .
+*
+      END

lapack-netlib/BLAS/SRC/cgemm.f

@@ -0,0 +1,483 @@
+*> \brief \b CGEMM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER K,LDA,LDB,LDC,M,N
+*       CHARACTER TRANSA,TRANSB
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CGEMM  performs one of the matrix-matrix operations
+*>
+*>    C := alpha*op( A )*op( B ) + beta*C,
+*>
+*> where  op( X ) is one of
+*>
+*>    op( X ) = X   or   op( X ) = X**T   or   op( X ) = X**H,
+*>
+*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
+*> an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANSA
+*> \verbatim
+*>          TRANSA is CHARACTER*1
+*>           On entry, TRANSA specifies the form of op( A ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSA = 'N' or 'n',  op( A ) = A.
+*>
+*>              TRANSA = 'T' or 't',  op( A ) = A**T.
+*>
+*>              TRANSA = 'C' or 'c',  op( A ) = A**H.
+*> \endverbatim
+*>
+*> \param[in] TRANSB
+*> \verbatim
+*>          TRANSB is CHARACTER*1
+*>           On entry, TRANSB specifies the form of op( B ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSB = 'N' or 'n',  op( B ) = B.
+*>
+*>              TRANSB = 'T' or 't',  op( B ) = B**T.
+*>
+*>              TRANSB = 'C' or 'c',  op( B ) = B**H.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry,  M  specifies  the number  of rows  of the  matrix
+*>           op( A )  and of the  matrix  C.  M  must  be at least  zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry,  N  specifies the number  of columns of the matrix
+*>           op( B ) and the number of columns of the matrix C. N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry,  K  specifies  the number of columns of the matrix
+*>           op( A ) and the number of rows of the matrix op( B ). K must
+*>           be at least  zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*>           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
+*>           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
+*>           part of the array  A  must contain the matrix  A,  otherwise
+*>           the leading  k by m  part of the array  A  must contain  the
+*>           matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
+*>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*>           least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          B is COMPLEX array of DIMENSION ( LDB, kb ), where kb is
+*>           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
+*>           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
+*>           part of the array  B  must contain the matrix  B,  otherwise
+*>           the leading  n by k  part of the array  B  must contain  the
+*>           matrix B.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
+*>           LDB must be at least  max( 1, k ), otherwise  LDB must be at
+*>           least  max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*>           supplied as zero then C need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array of DIMENSION ( LDC, n ).
+*>           Before entry, the leading  m by n  part of the array  C must
+*>           contain the matrix  C,  except when  beta  is zero, in which
+*>           case C need not be set on entry.
+*>           On exit, the array  C  is overwritten by the  m by n  matrix
+*>           ( alpha*op( A )*op( B ) + beta*C ).
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup complex_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      COMPLEX ALPHA,BETA
+      INTEGER K,LDA,LDB,LDC,M,N
+      CHARACTER TRANSA,TRANSB
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
+      LOGICAL CONJA,CONJB,NOTA,NOTB
+*     ..
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*
+*     Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
+*     conjugated or transposed, set  CONJA and CONJB  as true if  A  and
+*     B  respectively are to be  transposed but  not conjugated  and set
+*     NROWA, NCOLA and  NROWB  as the number of rows and  columns  of  A
+*     and the number of rows of  B  respectively.
+*
+      NOTA = LSAME(TRANSA,'N')
+      NOTB = LSAME(TRANSB,'N')
+      CONJA = LSAME(TRANSA,'C')
+      CONJB = LSAME(TRANSB,'C')
+      IF (NOTA) THEN
+          NROWA = M
+          NCOLA = K
+      ELSE
+          NROWA = K
+          NCOLA = M
+      END IF
+      IF (NOTB) THEN
+          NROWB = K
+      ELSE
+          NROWB = N
+      END IF
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND.
+     +    (.NOT.LSAME(TRANSA,'T'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND.
+     +         (.NOT.LSAME(TRANSB,'T'))) THEN
+          INFO = 2
+      ELSE IF (M.LT.0) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (K.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 8
+      ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
+          INFO = 10
+      ELSE IF (LDC.LT.MAX(1,M)) THEN
+          INFO = 13
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CGEMM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (BETA.EQ.ZERO) THEN
+              DO 20 J = 1,N
+                  DO 10 I = 1,M
+                      C(I,J) = ZERO
+   10             CONTINUE
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  DO 30 I = 1,M
+                      C(I,J) = BETA*C(I,J)
+   30             CONTINUE
+   40         CONTINUE
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (NOTB) THEN
+          IF (NOTA) THEN
+*
+*           Form  C := alpha*A*B + beta*C.
+*
+              DO 90 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 50 I = 1,M
+                          C(I,J) = ZERO
+   50                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 60 I = 1,M
+                          C(I,J) = BETA*C(I,J)
+   60                 CONTINUE
+                  END IF
+                  DO 80 L = 1,K
+                      TEMP = ALPHA*B(L,J)
+                      DO 70 I = 1,M
+                          C(I,J) = C(I,J) + TEMP*A(I,L)
+   70                 CONTINUE
+   80             CONTINUE
+   90         CONTINUE
+          ELSE IF (CONJA) THEN
+*
+*           Form  C := alpha*A**H*B + beta*C.
+*
+              DO 120 J = 1,N
+                  DO 110 I = 1,M
+                      TEMP = ZERO
+                      DO 100 L = 1,K
+                          TEMP = TEMP + CONJG(A(L,I))*B(L,J)
+  100                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  110             CONTINUE
+  120         CONTINUE
+          ELSE
+*
+*           Form  C := alpha*A**T*B + beta*C
+*
+              DO 150 J = 1,N
+                  DO 140 I = 1,M
+                      TEMP = ZERO
+                      DO 130 L = 1,K
+                          TEMP = TEMP + A(L,I)*B(L,J)
+  130                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  140             CONTINUE
+  150         CONTINUE
+          END IF
+      ELSE IF (NOTA) THEN
+          IF (CONJB) THEN
+*
+*           Form  C := alpha*A*B**H + beta*C.
+*
+              DO 200 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 160 I = 1,M
+                          C(I,J) = ZERO
+  160                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 170 I = 1,M
+                          C(I,J) = BETA*C(I,J)
+  170                 CONTINUE
+                  END IF
+                  DO 190 L = 1,K
+                      TEMP = ALPHA*CONJG(B(J,L))
+                      DO 180 I = 1,M
+                          C(I,J) = C(I,J) + TEMP*A(I,L)
+  180                 CONTINUE
+  190             CONTINUE
+  200         CONTINUE
+          ELSE
+*
+*           Form  C := alpha*A*B**T + beta*C
+*
+              DO 250 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 210 I = 1,M
+                          C(I,J) = ZERO
+  210                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 220 I = 1,M
+                          C(I,J) = BETA*C(I,J)
+  220                 CONTINUE
+                  END IF
+                  DO 240 L = 1,K
+                      TEMP = ALPHA*B(J,L)
+                      DO 230 I = 1,M
+                          C(I,J) = C(I,J) + TEMP*A(I,L)
+  230                 CONTINUE
+  240             CONTINUE
+  250         CONTINUE
+          END IF
+      ELSE IF (CONJA) THEN
+          IF (CONJB) THEN
+*
+*           Form  C := alpha*A**H*B**H + beta*C.
+*
+              DO 280 J = 1,N
+                  DO 270 I = 1,M
+                      TEMP = ZERO
+                      DO 260 L = 1,K
+                          TEMP = TEMP + CONJG(A(L,I))*CONJG(B(J,L))
+  260                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  270             CONTINUE
+  280         CONTINUE
+          ELSE
+*
+*           Form  C := alpha*A**H*B**T + beta*C
+*
+              DO 310 J = 1,N
+                  DO 300 I = 1,M
+                      TEMP = ZERO
+                      DO 290 L = 1,K
+                          TEMP = TEMP + CONJG(A(L,I))*B(J,L)
+  290                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  300             CONTINUE
+  310         CONTINUE
+          END IF
+      ELSE
+          IF (CONJB) THEN
+*
+*           Form  C := alpha*A**T*B**H + beta*C
+*
+              DO 340 J = 1,N
+                  DO 330 I = 1,M
+                      TEMP = ZERO
+                      DO 320 L = 1,K
+                          TEMP = TEMP + A(L,I)*CONJG(B(J,L))
+  320                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  330             CONTINUE
+  340         CONTINUE
+          ELSE
+*
+*           Form  C := alpha*A**T*B**T + beta*C
+*
+              DO 370 J = 1,N
+                  DO 360 I = 1,M
+                      TEMP = ZERO
+                      DO 350 L = 1,K
+                          TEMP = TEMP + A(L,I)*B(J,L)
+  350                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  360             CONTINUE
+  370         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CGEMM .
+*
+      END

lapack-netlib/BLAS/SRC/cgemv.f

@@ -0,0 +1,350 @@
+*> \brief \b CGEMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER INCX,INCY,LDA,M,N
+*       CHARACTER TRANS
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CGEMV performs one of the matrix-vector operations
+*>
+*>    y := alpha*A*x + beta*y,   or   y := alpha*A**T*x + beta*y,   or
+*>
+*>    y := alpha*A**H*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are vectors and A is an
+*> m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*>
+*>              TRANS = 'T' or 't'   y := alpha*A**T*x + beta*y.
+*>
+*>              TRANS = 'C' or 'c'   y := alpha*A**H*x + beta*y.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading m by n part of the array A must
+*>           contain the matrix of coefficients.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, m ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*>           Before entry, the incremented array X must contain the
+*>           vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is COMPLEX array of DIMENSION at least
+*>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*>           Before entry with BETA non-zero, the incremented array Y
+*>           must contain the vector y. On exit, Y is overwritten by the
+*>           updated vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      COMPLEX ALPHA,BETA
+      INTEGER INCX,INCY,LDA,M,N
+      CHARACTER TRANS
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
+      LOGICAL NOCONJ
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +    .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 1
+      ELSE IF (M.LT.0) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (LDA.LT.MAX(1,M)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CGEMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          LENX = N
+          LENY = M
+      ELSE
+          LENX = M
+          LENY = N
+      END IF
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (LENX-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (LENY-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,LENY
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,LENY
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,LENY
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,LENY
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+          JX = KX
+          IF (INCY.EQ.1) THEN
+              DO 60 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  DO 50 I = 1,M
+                      Y(I) = Y(I) + TEMP*A(I,J)
+   50             CONTINUE
+                  JX = JX + INCX
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  IY = KY
+                  DO 70 I = 1,M
+                      Y(IY) = Y(IY) + TEMP*A(I,J)
+                      IY = IY + INCY
+   70             CONTINUE
+                  JX = JX + INCX
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y := alpha*A**T*x + y  or  y := alpha*A**H*x + y.
+*
+          JY = KY
+          IF (INCX.EQ.1) THEN
+              DO 110 J = 1,N
+                  TEMP = ZERO
+                  IF (NOCONJ) THEN
+                      DO 90 I = 1,M
+                          TEMP = TEMP + A(I,J)*X(I)
+   90                 CONTINUE
+                  ELSE
+                      DO 100 I = 1,M
+                          TEMP = TEMP + CONJG(A(I,J))*X(I)
+  100                 CONTINUE
+                  END IF
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+  110         CONTINUE
+          ELSE
+              DO 140 J = 1,N
+                  TEMP = ZERO
+                  IX = KX
+                  IF (NOCONJ) THEN
+                      DO 120 I = 1,M
+                          TEMP = TEMP + A(I,J)*X(IX)
+                          IX = IX + INCX
+  120                 CONTINUE
+                  ELSE
+                      DO 130 I = 1,M
+                          TEMP = TEMP + CONJG(A(I,J))*X(IX)
+                          IX = IX + INCX
+  130                 CONTINUE
+                  END IF
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+  140         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CGEMV .
+*
+      END

lapack-netlib/BLAS/SRC/cgerc.f

@@ -0,0 +1,227 @@
+*> \brief \b CGERC
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA
+*       INTEGER INCX,INCY,LDA,M,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CGERC  performs the rank 1 operation
+*>
+*>    A := alpha*x*y**H + A,
+*>
+*> where alpha is a scalar, x is an m element vector, y is an n element
+*> vector and A is an m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the m
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*>          Y is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading m by n part of the array A must
+*>           contain the matrix of coefficients. On exit, A is
+*>           overwritten by the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,INCY,LDA,M,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JY,KX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (M.LT.0) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 7
+      ELSE IF (LDA.LT.MAX(1,M)) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CGERC ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (INCY.GT.0) THEN
+          JY = 1
+      ELSE
+          JY = 1 - (N-1)*INCY
+      END IF
+      IF (INCX.EQ.1) THEN
+          DO 20 J = 1,N
+              IF (Y(JY).NE.ZERO) THEN
+                  TEMP = ALPHA*CONJG(Y(JY))
+                  DO 10 I = 1,M
+                      A(I,J) = A(I,J) + X(I)*TEMP
+   10             CONTINUE
+              END IF
+              JY = JY + INCY
+   20     CONTINUE
+      ELSE
+          IF (INCX.GT.0) THEN
+              KX = 1
+          ELSE
+              KX = 1 - (M-1)*INCX
+          END IF
+          DO 40 J = 1,N
+              IF (Y(JY).NE.ZERO) THEN
+                  TEMP = ALPHA*CONJG(Y(JY))
+                  IX = KX
+                  DO 30 I = 1,M
+                      A(I,J) = A(I,J) + X(IX)*TEMP
+                      IX = IX + INCX
+   30             CONTINUE
+              END IF
+              JY = JY + INCY
+   40     CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of CGERC .
+*
+      END

lapack-netlib/BLAS/SRC/cgeru.f

@@ -0,0 +1,227 @@
+*> \brief \b CGERU
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA
+*       INTEGER INCX,INCY,LDA,M,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CGERU  performs the rank 1 operation
+*>
+*>    A := alpha*x*y**T + A,
+*>
+*> where alpha is a scalar, x is an m element vector, y is an n element
+*> vector and A is an m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the m
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*>          Y is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading m by n part of the array A must
+*>           contain the matrix of coefficients. On exit, A is
+*>           overwritten by the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGERU(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,INCY,LDA,M,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JY,KX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (M.LT.0) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 7
+      ELSE IF (LDA.LT.MAX(1,M)) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CGERU ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (INCY.GT.0) THEN
+          JY = 1
+      ELSE
+          JY = 1 - (N-1)*INCY
+      END IF
+      IF (INCX.EQ.1) THEN
+          DO 20 J = 1,N
+              IF (Y(JY).NE.ZERO) THEN
+                  TEMP = ALPHA*Y(JY)
+                  DO 10 I = 1,M
+                      A(I,J) = A(I,J) + X(I)*TEMP
+   10             CONTINUE
+              END IF
+              JY = JY + INCY
+   20     CONTINUE
+      ELSE
+          IF (INCX.GT.0) THEN
+              KX = 1
+          ELSE
+              KX = 1 - (M-1)*INCX
+          END IF
+          DO 40 J = 1,N
+              IF (Y(JY).NE.ZERO) THEN
+                  TEMP = ALPHA*Y(JY)
+                  IX = KX
+                  DO 30 I = 1,M
+                      A(I,J) = A(I,J) + X(IX)*TEMP
+                      IX = IX + INCX
+   30             CONTINUE
+              END IF
+              JY = JY + INCY
+   40     CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of CGERU .
+*
+      END

lapack-netlib/BLAS/SRC/chbmv.f

@@ -0,0 +1,380 @@
+*> \brief \b CHBMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER INCX,INCY,K,LDA,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHBMV  performs the matrix-vector  operation
+*>
+*>    y := alpha*A*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are n element vectors and
+*> A is an n by n hermitian band matrix, with k super-diagonals.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the band matrix A is being supplied as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  being supplied.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  being supplied.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry, K specifies the number of super-diagonals of the
+*>           matrix A. K must satisfy  0 .le. K.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*>           by n part of the array A must contain the upper triangular
+*>           band part of the hermitian matrix, supplied column by
+*>           column, with the leading diagonal of the matrix in row
+*>           ( k + 1 ) of the array, the first super-diagonal starting at
+*>           position 2 in row k, and so on. The top left k by k triangle
+*>           of the array A is not referenced.
+*>           The following program segment will transfer the upper
+*>           triangular part of a hermitian band matrix from conventional
+*>           full matrix storage to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = K + 1 - J
+*>                    DO 10, I = MAX( 1, J - K ), J
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*>           by n part of the array A must contain the lower triangular
+*>           band part of the hermitian matrix, supplied column by
+*>           column, with the leading diagonal of the matrix in row 1 of
+*>           the array, the first sub-diagonal starting at position 1 in
+*>           row 2, and so on. The bottom right k by k triangle of the
+*>           array A is not referenced.
+*>           The following program segment will transfer the lower
+*>           triangular part of a hermitian band matrix from conventional
+*>           full matrix storage to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = 1 - J
+*>                    DO 10, I = J, MIN( N, J + K )
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Note that the imaginary parts of the diagonal elements need
+*>           not be set and are assumed to be zero.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( k + 1 ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the
+*>           vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is COMPLEX array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the
+*>           vector y. On exit, Y is overwritten by the updated vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER INCX,INCY,K,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,KPLUS1,KX,KY,L
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,MIN,REAL
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (K.LT.0) THEN
+          INFO = 3
+      ELSE IF (LDA.LT. (K+1)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (N-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (N-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array A
+*     are accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,N
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,N
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,N
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,N
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  y  when upper triangle of A is stored.
+*
+          KPLUS1 = K + 1
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  L = KPLUS1 - J
+                  DO 50 I = MAX(1,J-K),J - 1
+                      Y(I) = Y(I) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + CONJG(A(L+I,J))*X(I)
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*REAL(A(KPLUS1,J)) + ALPHA*TEMP2
+   60         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 80 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  IX = KX
+                  IY = KY
+                  L = KPLUS1 - J
+                  DO 70 I = MAX(1,J-K),J - 1
+                      Y(IY) = Y(IY) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + CONJG(A(L+I,J))*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*REAL(A(KPLUS1,J)) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  IF (J.GT.K) THEN
+                      KX = KX + INCX
+                      KY = KY + INCY
+                  END IF
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y  when lower triangle of A is stored.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 100 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  Y(J) = Y(J) + TEMP1*REAL(A(1,J))
+                  L = 1 - J
+                  DO 90 I = J + 1,MIN(N,J+K)
+                      Y(I) = Y(I) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + CONJG(A(L+I,J))*X(I)
+   90             CONTINUE
+                  Y(J) = Y(J) + ALPHA*TEMP2
+  100         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 120 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  Y(JY) = Y(JY) + TEMP1*REAL(A(1,J))
+                  L = 1 - J
+                  IX = JX
+                  IY = JY
+                  DO 110 I = J + 1,MIN(N,J+K)
+                      IX = IX + INCX
+                      IY = IY + INCY
+                      Y(IY) = Y(IY) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + CONJG(A(L+I,J))*X(IX)
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CHBMV .
+*
+      END

lapack-netlib/BLAS/SRC/chemm.f

@@ -0,0 +1,371 @@
+*> \brief \b CHEMM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER LDA,LDB,LDC,M,N
+*       CHARACTER SIDE,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHEMM  performs one of the matrix-matrix operations
+*>
+*>    C := alpha*A*B + beta*C,
+*>
+*> or
+*>
+*>    C := alpha*B*A + beta*C,
+*>
+*> where alpha and beta are scalars, A is an hermitian matrix and  B and
+*> C are m by n matrices.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>           On entry,  SIDE  specifies whether  the  hermitian matrix  A
+*>           appears on the  left or right  in the  operation as follows:
+*>
+*>              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
+*>
+*>              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*>           triangular  part  of  the  hermitian  matrix   A  is  to  be
+*>           referenced as follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the upper triangular part of the
+*>                                  hermitian matrix is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the lower triangular part of the
+*>                                  hermitian matrix is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry,  M  specifies the number of rows of the matrix  C.
+*>           M  must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix C.
+*>           N  must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*>           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
+*>           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
+*>           the array  A  must contain the  hermitian matrix,  such that
+*>           when  UPLO = 'U' or 'u', the leading m by m upper triangular
+*>           part of the array  A  must contain the upper triangular part
+*>           of the  hermitian matrix and the  strictly  lower triangular
+*>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*>           the leading  m by m  lower triangular part  of the  array  A
+*>           must  contain  the  lower triangular part  of the  hermitian
+*>           matrix and the  strictly upper triangular part of  A  is not
+*>           referenced.
+*>           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
+*>           the array  A  must contain the  hermitian matrix,  such that
+*>           when  UPLO = 'U' or 'u', the leading n by n upper triangular
+*>           part of the array  A  must contain the upper triangular part
+*>           of the  hermitian matrix and the  strictly  lower triangular
+*>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*>           the leading  n by n  lower triangular part  of the  array  A
+*>           must  contain  the  lower triangular part  of the  hermitian
+*>           matrix and the  strictly upper triangular part of  A  is not
+*>           referenced.
+*>           Note that the imaginary parts  of the diagonal elements need
+*>           not be set, they are assumed to be zero.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
+*>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*>           least max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          B is COMPLEX array of DIMENSION ( LDB, n ).
+*>           Before entry, the leading  m by n part of the array  B  must
+*>           contain the matrix B.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*>           supplied as zero then C need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array of DIMENSION ( LDC, n ).
+*>           Before entry, the leading  m by n  part of the array  C must
+*>           contain the matrix  C,  except when  beta  is zero, in which
+*>           case C need not be set on entry.
+*>           On exit, the array  C  is overwritten by the  m by n updated
+*>           matrix.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHEMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER LDA,LDB,LDC,M,N
+      CHARACTER SIDE,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,REAL
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,J,K,NROWA
+      LOGICAL UPPER
+*     ..
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*
+*     Set NROWA as the number of rows of A.
+*
+      IF (LSAME(SIDE,'L')) THEN
+          NROWA = M
+      ELSE
+          NROWA = N
+      END IF
+      UPPER = LSAME(UPLO,'U')
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 2
+      ELSE IF (M.LT.0) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 7
+      ELSE IF (LDB.LT.MAX(1,M)) THEN
+          INFO = 9
+      ELSE IF (LDC.LT.MAX(1,M)) THEN
+          INFO = 12
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHEMM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (BETA.EQ.ZERO) THEN
+              DO 20 J = 1,N
+                  DO 10 I = 1,M
+                      C(I,J) = ZERO
+   10             CONTINUE
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  DO 30 I = 1,M
+                      C(I,J) = BETA*C(I,J)
+   30             CONTINUE
+   40         CONTINUE
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSAME(SIDE,'L')) THEN
+*
+*        Form  C := alpha*A*B + beta*C.
+*
+          IF (UPPER) THEN
+              DO 70 J = 1,N
+                  DO 60 I = 1,M
+                      TEMP1 = ALPHA*B(I,J)
+                      TEMP2 = ZERO
+                      DO 50 K = 1,I - 1
+                          C(K,J) = C(K,J) + TEMP1*A(K,I)
+                          TEMP2 = TEMP2 + B(K,J)*CONJG(A(K,I))
+   50                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = TEMP1*REAL(A(I,I)) + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + TEMP1*REAL(A(I,I)) +
+     +                             ALPHA*TEMP2
+                      END IF
+   60             CONTINUE
+   70         CONTINUE
+          ELSE
+              DO 100 J = 1,N
+                  DO 90 I = M,1,-1
+                      TEMP1 = ALPHA*B(I,J)
+                      TEMP2 = ZERO
+                      DO 80 K = I + 1,M
+                          C(K,J) = C(K,J) + TEMP1*A(K,I)
+                          TEMP2 = TEMP2 + B(K,J)*CONJG(A(K,I))
+   80                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = TEMP1*REAL(A(I,I)) + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + TEMP1*REAL(A(I,I)) +
+     +                             ALPHA*TEMP2
+                      END IF
+   90             CONTINUE
+  100         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  C := alpha*B*A + beta*C.
+*
+          DO 170 J = 1,N
+              TEMP1 = ALPHA*REAL(A(J,J))
+              IF (BETA.EQ.ZERO) THEN
+                  DO 110 I = 1,M
+                      C(I,J) = TEMP1*B(I,J)
+  110             CONTINUE
+              ELSE
+                  DO 120 I = 1,M
+                      C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
+  120             CONTINUE
+              END IF
+              DO 140 K = 1,J - 1
+                  IF (UPPER) THEN
+                      TEMP1 = ALPHA*A(K,J)
+                  ELSE
+                      TEMP1 = ALPHA*CONJG(A(J,K))
+                  END IF
+                  DO 130 I = 1,M
+                      C(I,J) = C(I,J) + TEMP1*B(I,K)
+  130             CONTINUE
+  140         CONTINUE
+              DO 160 K = J + 1,N
+                  IF (UPPER) THEN
+                      TEMP1 = ALPHA*CONJG(A(J,K))
+                  ELSE
+                      TEMP1 = ALPHA*A(K,J)
+                  END IF
+                  DO 150 I = 1,M
+                      C(I,J) = C(I,J) + TEMP1*B(I,K)
+  150             CONTINUE
+  160         CONTINUE
+  170     CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of CHEMM .
+*
+      END

lapack-netlib/BLAS/SRC/chemv.f

@@ -0,0 +1,337 @@
+*> \brief \b CHEMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER INCX,INCY,LDA,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHEMV  performs the matrix-vector  operation
+*>
+*>    y := alpha*A*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are n element vectors and
+*> A is an n by n hermitian matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the array A is to be referenced as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular part of the hermitian matrix and the strictly
+*>           lower triangular part of A is not referenced.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular part of the hermitian matrix and the strictly
+*>           upper triangular part of A is not referenced.
+*>           Note that the imaginary parts of the diagonal elements need
+*>           not be set and are assumed to be zero.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y. On exit, Y is overwritten by the updated
+*>           vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER INCX,INCY,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,REAL
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 5
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 7
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 10
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHEMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (N-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (N-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,N
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,N
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,N
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,N
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  y  when A is stored in upper triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  DO 50 I = 1,J - 1
+                      Y(I) = Y(I) + TEMP1*A(I,J)
+                      TEMP2 = TEMP2 + CONJG(A(I,J))*X(I)
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*REAL(A(J,J)) + ALPHA*TEMP2
+   60         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 80 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  IX = KX
+                  IY = KY
+                  DO 70 I = 1,J - 1
+                      Y(IY) = Y(IY) + TEMP1*A(I,J)
+                      TEMP2 = TEMP2 + CONJG(A(I,J))*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*REAL(A(J,J)) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y  when A is stored in lower triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 100 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  Y(J) = Y(J) + TEMP1*REAL(A(J,J))
+                  DO 90 I = J + 1,N
+                      Y(I) = Y(I) + TEMP1*A(I,J)
+                      TEMP2 = TEMP2 + CONJG(A(I,J))*X(I)
+   90             CONTINUE
+                  Y(J) = Y(J) + ALPHA*TEMP2
+  100         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 120 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  Y(JY) = Y(JY) + TEMP1*REAL(A(J,J))
+                  IX = JX
+                  IY = JY
+                  DO 110 I = J + 1,N
+                      IX = IX + INCX
+                      IY = IY + INCY
+                      Y(IY) = Y(IY) + TEMP1*A(I,J)
+                      TEMP2 = TEMP2 + CONJG(A(I,J))*X(IX)
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CHEMV .
+*
+      END

lapack-netlib/BLAS/SRC/cher.f

@@ -0,0 +1,278 @@
+*> \brief \b CHER
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHER(UPLO,N,ALPHA,X,INCX,A,LDA)
+* 
+*       .. Scalar Arguments ..
+*       REAL ALPHA
+*       INTEGER INCX,LDA,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHER   performs the hermitian rank 1 operation
+*>
+*>    A := alpha*x*x**H + A,
+*>
+*> where alpha is a real scalar, x is an n element vector and A is an
+*> n by n hermitian matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the array A is to be referenced as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular part of the hermitian matrix and the strictly
+*>           lower triangular part of A is not referenced. On exit, the
+*>           upper triangular part of the array A is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular part of the hermitian matrix and the strictly
+*>           upper triangular part of A is not referenced. On exit, the
+*>           lower triangular part of the array A is overwritten by the
+*>           lower triangular part of the updated matrix.
+*>           Note that the imaginary parts of the diagonal elements need
+*>           not be set, they are assumed to be zero, and on exit they
+*>           are set to zero.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHER(UPLO,N,ALPHA,X,INCX,A,LDA)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,KX
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,REAL
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 7
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHER  ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (ALPHA.EQ.REAL(ZERO))) RETURN
+*
+*     Set the start point in X if the increment is not unity.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  A  when A is stored in upper triangle.
+*
+          IF (INCX.EQ.1) THEN
+              DO 20 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*CONJG(X(J))
+                      DO 10 I = 1,J - 1
+                          A(I,J) = A(I,J) + X(I)*TEMP
+   10                 CONTINUE
+                      A(J,J) = REAL(A(J,J)) + REAL(X(J)*TEMP)
+                  ELSE
+                      A(J,J) = REAL(A(J,J))
+                  END IF
+   20         CONTINUE
+          ELSE
+              JX = KX
+              DO 40 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*CONJG(X(JX))
+                      IX = KX
+                      DO 30 I = 1,J - 1
+                          A(I,J) = A(I,J) + X(IX)*TEMP
+                          IX = IX + INCX
+   30                 CONTINUE
+                      A(J,J) = REAL(A(J,J)) + REAL(X(JX)*TEMP)
+                  ELSE
+                      A(J,J) = REAL(A(J,J))
+                  END IF
+                  JX = JX + INCX
+   40         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  A  when A is stored in lower triangle.
+*
+          IF (INCX.EQ.1) THEN
+              DO 60 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*CONJG(X(J))
+                      A(J,J) = REAL(A(J,J)) + REAL(TEMP*X(J))
+                      DO 50 I = J + 1,N
+                          A(I,J) = A(I,J) + X(I)*TEMP
+   50                 CONTINUE
+                  ELSE
+                      A(J,J) = REAL(A(J,J))
+                  END IF
+   60         CONTINUE
+          ELSE
+              JX = KX
+              DO 80 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*CONJG(X(JX))
+                      A(J,J) = REAL(A(J,J)) + REAL(TEMP*X(JX))
+                      IX = JX
+                      DO 70 I = J + 1,N
+                          IX = IX + INCX
+                          A(I,J) = A(I,J) + X(IX)*TEMP
+   70                 CONTINUE
+                  ELSE
+                      A(J,J) = REAL(A(J,J))
+                  END IF
+                  JX = JX + INCX
+   80         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CHER  .
+*
+      END

lapack-netlib/BLAS/SRC/cher2.f

@@ -0,0 +1,317 @@
+*> \brief \b CHER2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA
+*       INTEGER INCX,INCY,LDA,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHER2  performs the hermitian rank 2 operation
+*>
+*>    A := alpha*x*y**H + conjg( alpha )*y*x**H + A,
+*>
+*> where alpha is a scalar, x and y are n element vectors and A is an n
+*> by n hermitian matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the array A is to be referenced as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*>          Y is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular part of the hermitian matrix and the strictly
+*>           lower triangular part of A is not referenced. On exit, the
+*>           upper triangular part of the array A is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular part of the hermitian matrix and the strictly
+*>           upper triangular part of A is not referenced. On exit, the
+*>           lower triangular part of the array A is overwritten by the
+*>           lower triangular part of the updated matrix.
+*>           Note that the imaginary parts of the diagonal elements need
+*>           not be set, they are assumed to be zero, and on exit they
+*>           are set to zero.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHER2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,INCY,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,REAL
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 7
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHER2 ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Set up the start points in X and Y if the increments are not both
+*     unity.
+*
+      IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
+          IF (INCX.GT.0) THEN
+              KX = 1
+          ELSE
+              KX = 1 - (N-1)*INCX
+          END IF
+          IF (INCY.GT.0) THEN
+              KY = 1
+          ELSE
+              KY = 1 - (N-1)*INCY
+          END IF
+          JX = KX
+          JY = KY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  A  when A is stored in the upper triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 20 J = 1,N
+                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*CONJG(Y(J))
+                      TEMP2 = CONJG(ALPHA*X(J))
+                      DO 10 I = 1,J - 1
+                          A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
+   10                 CONTINUE
+                      A(J,J) = REAL(A(J,J)) +
+     +                         REAL(X(J)*TEMP1+Y(J)*TEMP2)
+                  ELSE
+                      A(J,J) = REAL(A(J,J))
+                  END IF
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*CONJG(Y(JY))
+                      TEMP2 = CONJG(ALPHA*X(JX))
+                      IX = KX
+                      IY = KY
+                      DO 30 I = 1,J - 1
+                          A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
+                          IX = IX + INCX
+                          IY = IY + INCY
+   30                 CONTINUE
+                      A(J,J) = REAL(A(J,J)) +
+     +                         REAL(X(JX)*TEMP1+Y(JY)*TEMP2)
+                  ELSE
+                      A(J,J) = REAL(A(J,J))
+                  END IF
+                  JX = JX + INCX
+                  JY = JY + INCY
+   40         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  A  when A is stored in the lower triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*CONJG(Y(J))
+                      TEMP2 = CONJG(ALPHA*X(J))
+                      A(J,J) = REAL(A(J,J)) +
+     +                         REAL(X(J)*TEMP1+Y(J)*TEMP2)
+                      DO 50 I = J + 1,N
+                          A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
+   50                 CONTINUE
+                  ELSE
+                      A(J,J) = REAL(A(J,J))
+                  END IF
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*CONJG(Y(JY))
+                      TEMP2 = CONJG(ALPHA*X(JX))
+                      A(J,J) = REAL(A(J,J)) +
+     +                         REAL(X(JX)*TEMP1+Y(JY)*TEMP2)
+                      IX = JX
+                      IY = JY
+                      DO 70 I = J + 1,N
+                          IX = IX + INCX
+                          IY = IY + INCY
+                          A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
+   70                 CONTINUE
+                  ELSE
+                      A(J,J) = REAL(A(J,J))
+                  END IF
+                  JX = JX + INCX
+                  JY = JY + INCY
+   80         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CHER2 .
+*
+      END

lapack-netlib/BLAS/SRC/cher2k.f

@@ -0,0 +1,442 @@
+*> \brief \b CHER2K
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA
+*       REAL BETA
+*       INTEGER K,LDA,LDB,LDC,N
+*       CHARACTER TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHER2K  performs one of the hermitian rank 2k operations
+*>
+*>    C := alpha*A*B**H + conjg( alpha )*B*A**H + beta*C,
+*>
+*> or
+*>
+*>    C := alpha*A**H*B + conjg( alpha )*B**H*A + beta*C,
+*>
+*> where  alpha and beta  are scalars with  beta  real,  C is an  n by n
+*> hermitian matrix and  A and B  are  n by k matrices in the first case
+*> and  k by n  matrices in the second case.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*>           triangular  part  of the  array  C  is to be  referenced  as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry,  TRANS  specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'    C := alpha*A*B**H          +
+*>                                         conjg( alpha )*B*A**H +
+*>                                         beta*C.
+*>
+*>              TRANS = 'C' or 'c'    C := alpha*A**H*B          +
+*>                                         conjg( alpha )*B**H*A +
+*>                                         beta*C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry,  N specifies the order of the matrix C.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*>           of  columns  of the  matrices  A and B,  and on  entry  with
+*>           TRANS = 'C' or 'c',  K  specifies  the number of rows of the
+*>           matrices  A and B.  K must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*>           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*>           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*>           part of the array  A  must contain the matrix  A,  otherwise
+*>           the leading  k by n  part of the array  A  must contain  the
+*>           matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*>           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*>           be at least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          B is COMPLEX array of DIMENSION ( LDB, kb ), where kb is
+*>           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*>           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*>           part of the array  B  must contain the matrix  B,  otherwise
+*>           the leading  k by n  part of the array  B  must contain  the
+*>           matrix B.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*>           then  LDB must be at least  max( 1, n ), otherwise  LDB must
+*>           be at least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is REAL
+*>           On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array of DIMENSION ( LDC, n ).
+*>           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*>           upper triangular part of the array C must contain the upper
+*>           triangular part  of the  hermitian matrix  and the strictly
+*>           lower triangular part of C is not referenced.  On exit, the
+*>           upper triangular part of the array  C is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*>           lower triangular part of the array C must contain the lower
+*>           triangular part  of the  hermitian matrix  and the strictly
+*>           upper triangular part of C is not referenced.  On exit, the
+*>           lower triangular part of the array  C is overwritten by the
+*>           lower triangular part of the updated matrix.
+*>           Note that the imaginary parts of the diagonal elements need
+*>           not be set,  they are assumed to be zero,  and on exit they
+*>           are set to zero.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*>
+*>  -- Modified 8-Nov-93 to set C(J,J) to REAL( C(J,J) ) when BETA = 1.
+*>     Ed Anderson, Cray Research Inc.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHER2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      REAL BETA
+      INTEGER K,LDA,LDB,LDC,N
+      CHARACTER TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,REAL
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,J,L,NROWA
+      LOGICAL UPPER
+*     ..
+*     .. Parameters ..
+      REAL ONE
+      PARAMETER (ONE=1.0E+0)
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*
+*     Test the input parameters.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          NROWA = N
+      ELSE
+          NROWA = K
+      END IF
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
+     +         (.NOT.LSAME(TRANS,'C'))) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (K.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 7
+      ELSE IF (LDB.LT.MAX(1,NROWA)) THEN
+          INFO = 9
+      ELSE IF (LDC.LT.MAX(1,N)) THEN
+          INFO = 12
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHER2K',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
+     +    (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (UPPER) THEN
+              IF (BETA.EQ.REAL(ZERO)) THEN
+                  DO 20 J = 1,N
+                      DO 10 I = 1,J
+                          C(I,J) = ZERO
+   10                 CONTINUE
+   20             CONTINUE
+              ELSE
+                  DO 40 J = 1,N
+                      DO 30 I = 1,J - 1
+                          C(I,J) = BETA*C(I,J)
+   30                 CONTINUE
+                      C(J,J) = BETA*REAL(C(J,J))
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (BETA.EQ.REAL(ZERO)) THEN
+                  DO 60 J = 1,N
+                      DO 50 I = J,N
+                          C(I,J) = ZERO
+   50                 CONTINUE
+   60             CONTINUE
+              ELSE
+                  DO 80 J = 1,N
+                      C(J,J) = BETA*REAL(C(J,J))
+                      DO 70 I = J + 1,N
+                          C(I,J) = BETA*C(I,J)
+   70                 CONTINUE
+   80             CONTINUE
+              END IF
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  C := alpha*A*B**H + conjg( alpha )*B*A**H +
+*                   C.
+*
+          IF (UPPER) THEN
+              DO 130 J = 1,N
+                  IF (BETA.EQ.REAL(ZERO)) THEN
+                      DO 90 I = 1,J
+                          C(I,J) = ZERO
+   90                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 100 I = 1,J - 1
+                          C(I,J) = BETA*C(I,J)
+  100                 CONTINUE
+                      C(J,J) = BETA*REAL(C(J,J))
+                  ELSE
+                      C(J,J) = REAL(C(J,J))
+                  END IF
+                  DO 120 L = 1,K
+                      IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
+                          TEMP1 = ALPHA*CONJG(B(J,L))
+                          TEMP2 = CONJG(ALPHA*A(J,L))
+                          DO 110 I = 1,J - 1
+                              C(I,J) = C(I,J) + A(I,L)*TEMP1 +
+     +                                 B(I,L)*TEMP2
+  110                     CONTINUE
+                          C(J,J) = REAL(C(J,J)) +
+     +                             REAL(A(J,L)*TEMP1+B(J,L)*TEMP2)
+                      END IF
+  120             CONTINUE
+  130         CONTINUE
+          ELSE
+              DO 180 J = 1,N
+                  IF (BETA.EQ.REAL(ZERO)) THEN
+                      DO 140 I = J,N
+                          C(I,J) = ZERO
+  140                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 150 I = J + 1,N
+                          C(I,J) = BETA*C(I,J)
+  150                 CONTINUE
+                      C(J,J) = BETA*REAL(C(J,J))
+                  ELSE
+                      C(J,J) = REAL(C(J,J))
+                  END IF
+                  DO 170 L = 1,K
+                      IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
+                          TEMP1 = ALPHA*CONJG(B(J,L))
+                          TEMP2 = CONJG(ALPHA*A(J,L))
+                          DO 160 I = J + 1,N
+                              C(I,J) = C(I,J) + A(I,L)*TEMP1 +
+     +                                 B(I,L)*TEMP2
+  160                     CONTINUE
+                          C(J,J) = REAL(C(J,J)) +
+     +                             REAL(A(J,L)*TEMP1+B(J,L)*TEMP2)
+                      END IF
+  170             CONTINUE
+  180         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  C := alpha*A**H*B + conjg( alpha )*B**H*A +
+*                   C.
+*
+          IF (UPPER) THEN
+              DO 210 J = 1,N
+                  DO 200 I = 1,J
+                      TEMP1 = ZERO
+                      TEMP2 = ZERO
+                      DO 190 L = 1,K
+                          TEMP1 = TEMP1 + CONJG(A(L,I))*B(L,J)
+                          TEMP2 = TEMP2 + CONJG(B(L,I))*A(L,J)
+  190                 CONTINUE
+                      IF (I.EQ.J) THEN
+                          IF (BETA.EQ.REAL(ZERO)) THEN
+                              C(J,J) = REAL(ALPHA*TEMP1+
+     +                                 CONJG(ALPHA)*TEMP2)
+                          ELSE
+                              C(J,J) = BETA*REAL(C(J,J)) +
+     +                                 REAL(ALPHA*TEMP1+
+     +                                 CONJG(ALPHA)*TEMP2)
+                          END IF
+                      ELSE
+                          IF (BETA.EQ.REAL(ZERO)) THEN
+                              C(I,J) = ALPHA*TEMP1 + CONJG(ALPHA)*TEMP2
+                          ELSE
+                              C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
+     +                                 CONJG(ALPHA)*TEMP2
+                          END IF
+                      END IF
+  200             CONTINUE
+  210         CONTINUE
+          ELSE
+              DO 240 J = 1,N
+                  DO 230 I = J,N
+                      TEMP1 = ZERO
+                      TEMP2 = ZERO
+                      DO 220 L = 1,K
+                          TEMP1 = TEMP1 + CONJG(A(L,I))*B(L,J)
+                          TEMP2 = TEMP2 + CONJG(B(L,I))*A(L,J)
+  220                 CONTINUE
+                      IF (I.EQ.J) THEN
+                          IF (BETA.EQ.REAL(ZERO)) THEN
+                              C(J,J) = REAL(ALPHA*TEMP1+
+     +                                 CONJG(ALPHA)*TEMP2)
+                          ELSE
+                              C(J,J) = BETA*REAL(C(J,J)) +
+     +                                 REAL(ALPHA*TEMP1+
+     +                                 CONJG(ALPHA)*TEMP2)
+                          END IF
+                      ELSE
+                          IF (BETA.EQ.REAL(ZERO)) THEN
+                              C(I,J) = ALPHA*TEMP1 + CONJG(ALPHA)*TEMP2
+                          ELSE
+                              C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
+     +                                 CONJG(ALPHA)*TEMP2
+                          END IF
+                      END IF
+  230             CONTINUE
+  240         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CHER2K.
+*
+      END

lapack-netlib/BLAS/SRC/cherk.f

@@ -0,0 +1,396 @@
+*> \brief \b CHERK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       REAL ALPHA,BETA
+*       INTEGER K,LDA,LDC,N
+*       CHARACTER TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHERK  performs one of the hermitian rank k operations
+*>
+*>    C := alpha*A*A**H + beta*C,
+*>
+*> or
+*>
+*>    C := alpha*A**H*A + beta*C,
+*>
+*> where  alpha and beta  are  real scalars,  C is an  n by n  hermitian
+*> matrix and  A  is an  n by k  matrix in the  first case and a  k by n
+*> matrix in the second case.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*>           triangular  part  of the  array  C  is to be  referenced  as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry,  TRANS  specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   C := alpha*A*A**H + beta*C.
+*>
+*>              TRANS = 'C' or 'c'   C := alpha*A**H*A + beta*C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry,  N specifies the order of the matrix C.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*>           of  columns   of  the   matrix   A,   and  on   entry   with
+*>           TRANS = 'C' or 'c',  K  specifies  the number of rows of the
+*>           matrix A.  K must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*>           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*>           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*>           part of the array  A  must contain the matrix  A,  otherwise
+*>           the leading  k by n  part of the array  A  must contain  the
+*>           matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*>           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*>           be at least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is REAL
+*>           On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array of DIMENSION ( LDC, n ).
+*>           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*>           upper triangular part of the array C must contain the upper
+*>           triangular part  of the  hermitian matrix  and the strictly
+*>           lower triangular part of C is not referenced.  On exit, the
+*>           upper triangular part of the array  C is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*>           lower triangular part of the array C must contain the lower
+*>           triangular part  of the  hermitian matrix  and the strictly
+*>           upper triangular part of C is not referenced.  On exit, the
+*>           lower triangular part of the array  C is overwritten by the
+*>           lower triangular part of the updated matrix.
+*>           Note that the imaginary parts of the diagonal elements need
+*>           not be set,  they are assumed to be zero,  and on exit they
+*>           are set to zero.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*>
+*>  -- Modified 8-Nov-93 to set C(J,J) to REAL( C(J,J) ) when BETA = 1.
+*>     Ed Anderson, Cray Research Inc.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHERK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER K,LDA,LDC,N
+      CHARACTER TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CMPLX,CONJG,MAX,REAL
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      REAL RTEMP
+      INTEGER I,INFO,J,L,NROWA
+      LOGICAL UPPER
+*     ..
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*
+*     Test the input parameters.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          NROWA = N
+      ELSE
+          NROWA = K
+      END IF
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
+     +         (.NOT.LSAME(TRANS,'C'))) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (K.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 7
+      ELSE IF (LDC.LT.MAX(1,N)) THEN
+          INFO = 10
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHERK ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
+     +    (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (UPPER) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 20 J = 1,N
+                      DO 10 I = 1,J
+                          C(I,J) = ZERO
+   10                 CONTINUE
+   20             CONTINUE
+              ELSE
+                  DO 40 J = 1,N
+                      DO 30 I = 1,J - 1
+                          C(I,J) = BETA*C(I,J)
+   30                 CONTINUE
+                      C(J,J) = BETA*REAL(C(J,J))
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (BETA.EQ.ZERO) THEN
+                  DO 60 J = 1,N
+                      DO 50 I = J,N
+                          C(I,J) = ZERO
+   50                 CONTINUE
+   60             CONTINUE
+              ELSE
+                  DO 80 J = 1,N
+                      C(J,J) = BETA*REAL(C(J,J))
+                      DO 70 I = J + 1,N
+                          C(I,J) = BETA*C(I,J)
+   70                 CONTINUE
+   80             CONTINUE
+              END IF
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  C := alpha*A*A**H + beta*C.
+*
+          IF (UPPER) THEN
+              DO 130 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 90 I = 1,J
+                          C(I,J) = ZERO
+   90                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 100 I = 1,J - 1
+                          C(I,J) = BETA*C(I,J)
+  100                 CONTINUE
+                      C(J,J) = BETA*REAL(C(J,J))
+                  ELSE
+                      C(J,J) = REAL(C(J,J))
+                  END IF
+                  DO 120 L = 1,K
+                      IF (A(J,L).NE.CMPLX(ZERO)) THEN
+                          TEMP = ALPHA*CONJG(A(J,L))
+                          DO 110 I = 1,J - 1
+                              C(I,J) = C(I,J) + TEMP*A(I,L)
+  110                     CONTINUE
+                          C(J,J) = REAL(C(J,J)) + REAL(TEMP*A(I,L))
+                      END IF
+  120             CONTINUE
+  130         CONTINUE
+          ELSE
+              DO 180 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 140 I = J,N
+                          C(I,J) = ZERO
+  140                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      C(J,J) = BETA*REAL(C(J,J))
+                      DO 150 I = J + 1,N
+                          C(I,J) = BETA*C(I,J)
+  150                 CONTINUE
+                  ELSE
+                      C(J,J) = REAL(C(J,J))
+                  END IF
+                  DO 170 L = 1,K
+                      IF (A(J,L).NE.CMPLX(ZERO)) THEN
+                          TEMP = ALPHA*CONJG(A(J,L))
+                          C(J,J) = REAL(C(J,J)) + REAL(TEMP*A(J,L))
+                          DO 160 I = J + 1,N
+                              C(I,J) = C(I,J) + TEMP*A(I,L)
+  160                     CONTINUE
+                      END IF
+  170             CONTINUE
+  180         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  C := alpha*A**H*A + beta*C.
+*
+          IF (UPPER) THEN
+              DO 220 J = 1,N
+                  DO 200 I = 1,J - 1
+                      TEMP = ZERO
+                      DO 190 L = 1,K
+                          TEMP = TEMP + CONJG(A(L,I))*A(L,J)
+  190                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  200             CONTINUE
+                  RTEMP = ZERO
+                  DO 210 L = 1,K
+                      RTEMP = RTEMP + CONJG(A(L,J))*A(L,J)
+  210             CONTINUE
+                  IF (BETA.EQ.ZERO) THEN
+                      C(J,J) = ALPHA*RTEMP
+                  ELSE
+                      C(J,J) = ALPHA*RTEMP + BETA*REAL(C(J,J))
+                  END IF
+  220         CONTINUE
+          ELSE
+              DO 260 J = 1,N
+                  RTEMP = ZERO
+                  DO 230 L = 1,K
+                      RTEMP = RTEMP + CONJG(A(L,J))*A(L,J)
+  230             CONTINUE
+                  IF (BETA.EQ.ZERO) THEN
+                      C(J,J) = ALPHA*RTEMP
+                  ELSE
+                      C(J,J) = ALPHA*RTEMP + BETA*REAL(C(J,J))
+                  END IF
+                  DO 250 I = J + 1,N
+                      TEMP = ZERO
+                      DO 240 L = 1,K
+                          TEMP = TEMP + CONJG(A(L,I))*A(L,J)
+  240                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  250             CONTINUE
+  260         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CHERK .
+*
+      END

lapack-netlib/BLAS/SRC/chpmv.f

@@ -0,0 +1,338 @@
+*> \brief \b CHPMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER INCX,INCY,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX AP(*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHPMV  performs the matrix-vector operation
+*>
+*>    y := alpha*A*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are n element vectors and
+*> A is an n by n hermitian matrix, supplied in packed form.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the matrix A is supplied in the packed
+*>           array AP as follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  supplied in AP.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  supplied in AP.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] AP
+*> \verbatim
+*>          AP is COMPLEX array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular part of the hermitian matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*>           and a( 2, 2 ) respectively, and so on.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular part of the hermitian matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*>           and a( 3, 1 ) respectively, and so on.
+*>           Note that the imaginary parts of the diagonal elements need
+*>           not be set and are assumed to be zero.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y. On exit, Y is overwritten by the updated
+*>           vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER INCX,INCY,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX AP(*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,REAL
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 6
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHPMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (N-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (N-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,N
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,N
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,N
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,N
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      KK = 1
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  y  when AP contains the upper triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  K = KK
+                  DO 50 I = 1,J - 1
+                      Y(I) = Y(I) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + CONJG(AP(K))*X(I)
+                      K = K + 1
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*REAL(AP(KK+J-1)) + ALPHA*TEMP2
+                  KK = KK + J
+   60         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 80 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  IX = KX
+                  IY = KY
+                  DO 70 K = KK,KK + J - 2
+                      Y(IY) = Y(IY) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + CONJG(AP(K))*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*REAL(AP(KK+J-1)) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  KK = KK + J
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y  when AP contains the lower triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 100 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  Y(J) = Y(J) + TEMP1*REAL(AP(KK))
+                  K = KK + 1
+                  DO 90 I = J + 1,N
+                      Y(I) = Y(I) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + CONJG(AP(K))*X(I)
+                      K = K + 1
+   90             CONTINUE
+                  Y(J) = Y(J) + ALPHA*TEMP2
+                  KK = KK + (N-J+1)
+  100         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 120 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  Y(JY) = Y(JY) + TEMP1*REAL(AP(KK))
+                  IX = JX
+                  IY = JY
+                  DO 110 K = KK + 1,KK + N - J
+                      IX = IX + INCX
+                      IY = IY + INCY
+                      Y(IY) = Y(IY) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + CONJG(AP(K))*X(IX)
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  KK = KK + (N-J+1)
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CHPMV .
+*
+      END

lapack-netlib/BLAS/SRC/chpr.f

@@ -0,0 +1,279 @@
+*> \brief \b CHPR
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHPR(UPLO,N,ALPHA,X,INCX,AP)
+* 
+*       .. Scalar Arguments ..
+*       REAL ALPHA
+*       INTEGER INCX,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX AP(*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHPR    performs the hermitian rank 1 operation
+*>
+*>    A := alpha*x*x**H + A,
+*>
+*> where alpha is a real scalar, x is an n element vector and A is an
+*> n by n hermitian matrix, supplied in packed form.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the matrix A is supplied in the packed
+*>           array AP as follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  supplied in AP.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  supplied in AP.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] AP
+*> \verbatim
+*>          AP is COMPLEX array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with  UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular part of the hermitian matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*>           and a( 2, 2 ) respectively, and so on. On exit, the array
+*>           AP is overwritten by the upper triangular part of the
+*>           updated matrix.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular part of the hermitian matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*>           and a( 3, 1 ) respectively, and so on. On exit, the array
+*>           AP is overwritten by the lower triangular part of the
+*>           updated matrix.
+*>           Note that the imaginary parts of the diagonal elements need
+*>           not be set, they are assumed to be zero, and on exit they
+*>           are set to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHPR(UPLO,N,ALPHA,X,INCX,AP)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX AP(*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,K,KK,KX
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,REAL
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHPR  ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (ALPHA.EQ.REAL(ZERO))) RETURN
+*
+*     Set the start point in X if the increment is not unity.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+      KK = 1
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  A  when upper triangle is stored in AP.
+*
+          IF (INCX.EQ.1) THEN
+              DO 20 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*CONJG(X(J))
+                      K = KK
+                      DO 10 I = 1,J - 1
+                          AP(K) = AP(K) + X(I)*TEMP
+                          K = K + 1
+   10                 CONTINUE
+                      AP(KK+J-1) = REAL(AP(KK+J-1)) + REAL(X(J)*TEMP)
+                  ELSE
+                      AP(KK+J-1) = REAL(AP(KK+J-1))
+                  END IF
+                  KK = KK + J
+   20         CONTINUE
+          ELSE
+              JX = KX
+              DO 40 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*CONJG(X(JX))
+                      IX = KX
+                      DO 30 K = KK,KK + J - 2
+                          AP(K) = AP(K) + X(IX)*TEMP
+                          IX = IX + INCX
+   30                 CONTINUE
+                      AP(KK+J-1) = REAL(AP(KK+J-1)) + REAL(X(JX)*TEMP)
+                  ELSE
+                      AP(KK+J-1) = REAL(AP(KK+J-1))
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + J
+   40         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  A  when lower triangle is stored in AP.
+*
+          IF (INCX.EQ.1) THEN
+              DO 60 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*CONJG(X(J))
+                      AP(KK) = REAL(AP(KK)) + REAL(TEMP*X(J))
+                      K = KK + 1
+                      DO 50 I = J + 1,N
+                          AP(K) = AP(K) + X(I)*TEMP
+                          K = K + 1
+   50                 CONTINUE
+                  ELSE
+                      AP(KK) = REAL(AP(KK))
+                  END IF
+                  KK = KK + N - J + 1
+   60         CONTINUE
+          ELSE
+              JX = KX
+              DO 80 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*CONJG(X(JX))
+                      AP(KK) = REAL(AP(KK)) + REAL(TEMP*X(JX))
+                      IX = JX
+                      DO 70 K = KK + 1,KK + N - J
+                          IX = IX + INCX
+                          AP(K) = AP(K) + X(IX)*TEMP
+   70                 CONTINUE
+                  ELSE
+                      AP(KK) = REAL(AP(KK))
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + N - J + 1
+   80         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CHPR  .
+*
+      END

lapack-netlib/BLAS/SRC/chpr2.f

@@ -0,0 +1,318 @@
+*> \brief \b CHPR2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CHPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA
+*       INTEGER INCX,INCY,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX AP(*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CHPR2  performs the hermitian rank 2 operation
+*>
+*>    A := alpha*x*y**H + conjg( alpha )*y*x**H + A,
+*>
+*> where alpha is a scalar, x and y are n element vectors and A is an
+*> n by n hermitian matrix, supplied in packed form.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the matrix A is supplied in the packed
+*>           array AP as follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  supplied in AP.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  supplied in AP.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*>          Y is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] AP
+*> \verbatim
+*>          AP is COMPLEX array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with  UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular part of the hermitian matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*>           and a( 2, 2 ) respectively, and so on. On exit, the array
+*>           AP is overwritten by the upper triangular part of the
+*>           updated matrix.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular part of the hermitian matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*>           and a( 3, 1 ) respectively, and so on. On exit, the array
+*>           AP is overwritten by the lower triangular part of the
+*>           updated matrix.
+*>           Note that the imaginary parts of the diagonal elements need
+*>           not be set, they are assumed to be zero, and on exit they
+*>           are set to zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CHPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,INCY,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX AP(*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,REAL
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 7
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CHPR2 ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Set up the start points in X and Y if the increments are not both
+*     unity.
+*
+      IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
+          IF (INCX.GT.0) THEN
+              KX = 1
+          ELSE
+              KX = 1 - (N-1)*INCX
+          END IF
+          IF (INCY.GT.0) THEN
+              KY = 1
+          ELSE
+              KY = 1 - (N-1)*INCY
+          END IF
+          JX = KX
+          JY = KY
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+      KK = 1
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  A  when upper triangle is stored in AP.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 20 J = 1,N
+                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*CONJG(Y(J))
+                      TEMP2 = CONJG(ALPHA*X(J))
+                      K = KK
+                      DO 10 I = 1,J - 1
+                          AP(K) = AP(K) + X(I)*TEMP1 + Y(I)*TEMP2
+                          K = K + 1
+   10                 CONTINUE
+                      AP(KK+J-1) = REAL(AP(KK+J-1)) +
+     +                             REAL(X(J)*TEMP1+Y(J)*TEMP2)
+                  ELSE
+                      AP(KK+J-1) = REAL(AP(KK+J-1))
+                  END IF
+                  KK = KK + J
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*CONJG(Y(JY))
+                      TEMP2 = CONJG(ALPHA*X(JX))
+                      IX = KX
+                      IY = KY
+                      DO 30 K = KK,KK + J - 2
+                          AP(K) = AP(K) + X(IX)*TEMP1 + Y(IY)*TEMP2
+                          IX = IX + INCX
+                          IY = IY + INCY
+   30                 CONTINUE
+                      AP(KK+J-1) = REAL(AP(KK+J-1)) +
+     +                             REAL(X(JX)*TEMP1+Y(JY)*TEMP2)
+                  ELSE
+                      AP(KK+J-1) = REAL(AP(KK+J-1))
+                  END IF
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  KK = KK + J
+   40         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  A  when lower triangle is stored in AP.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*CONJG(Y(J))
+                      TEMP2 = CONJG(ALPHA*X(J))
+                      AP(KK) = REAL(AP(KK)) +
+     +                         REAL(X(J)*TEMP1+Y(J)*TEMP2)
+                      K = KK + 1
+                      DO 50 I = J + 1,N
+                          AP(K) = AP(K) + X(I)*TEMP1 + Y(I)*TEMP2
+                          K = K + 1
+   50                 CONTINUE
+                  ELSE
+                      AP(KK) = REAL(AP(KK))
+                  END IF
+                  KK = KK + N - J + 1
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*CONJG(Y(JY))
+                      TEMP2 = CONJG(ALPHA*X(JX))
+                      AP(KK) = REAL(AP(KK)) +
+     +                         REAL(X(JX)*TEMP1+Y(JY)*TEMP2)
+                      IX = JX
+                      IY = JY
+                      DO 70 K = KK + 1,KK + N - J
+                          IX = IX + INCX
+                          IY = IY + INCY
+                          AP(K) = AP(K) + X(IX)*TEMP1 + Y(IY)*TEMP2
+   70                 CONTINUE
+                  ELSE
+                      AP(KK) = REAL(AP(KK))
+                  END IF
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  KK = KK + N - J + 1
+   80         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CHPR2 .
+*
+      END

lapack-netlib/BLAS/SRC/crotg.f

@@ -0,0 +1,74 @@
+*> \brief \b CROTG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CROTG(CA,CB,C,S)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX CA,CB,S
+*       REAL C
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CROTG determines a complex Givens rotation.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level1
+*
+*  =====================================================================
+      SUBROUTINE CROTG(CA,CB,C,S)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 CA,CB,S
+      REAL C
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      COMPLEX ALPHA
+      REAL NORM,SCALE
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CABS,CONJG,SQRT
+*     ..
+      IF (CABS(CA).EQ.0.) THEN
+         C = 0.
+         S = (1.,0.)
+         CA = CB
+      ELSE
+         SCALE = CABS(CA) + CABS(CB)
+         NORM = SCALE*SQRT((CABS(CA/SCALE))**2+ (CABS(CB/SCALE))**2)
+         ALPHA = CA/CABS(CA)
+         C = CABS(CA)/NORM
+         S = ALPHA*CONJG(CB)/NORM
+         CA = ALPHA*NORM
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/cscal.f

@@ -0,0 +1,91 @@
+*> \brief \b CSCAL
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSCAL(N,CA,CX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX CA
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX CX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    CSCAL scales a vector by a constant.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack,  3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CSCAL(N,CA,CX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 CA
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,NINCX
+*     ..
+      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+         DO I = 1,N
+            CX(I) = CA*CX(I)
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         NINCX = N*INCX
+         DO I = 1,NINCX,INCX
+            CX(I) = CA*CX(I)
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/csrot.f

@@ -0,0 +1,153 @@
+*> \brief \b CSROT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSROT( N, CX, INCX, CY, INCY, C, S )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INCX, INCY, N
+*       REAL              C, S
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX           CX( * ), CY( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CSROT applies a plane rotation, where the cos and sin (c and s) are real
+*> and the vectors cx and cy are complex.
+*> jack dongarra, linpack, 3/11/78.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the vectors cx and cy.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in,out] CX
+*> \verbatim
+*>          CX is COMPLEX array, dimension at least
+*>           ( 1 + ( N - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array CX must contain the n
+*>           element vector cx. On exit, CX is overwritten by the updated
+*>           vector cx.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           CX. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] CY
+*> \verbatim
+*>          CY is COMPLEX array, dimension at least
+*>           ( 1 + ( N - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array CY must contain the n
+*>           element vector cy. On exit, CY is overwritten by the updated
+*>           vector cy.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           CY. INCY must not be zero.
+*> \endverbatim
+*>
+*> \param[in] C
+*> \verbatim
+*>          C is REAL
+*>           On entry, C specifies the cosine, cos.
+*> \endverbatim
+*>
+*> \param[in] S
+*> \verbatim
+*>          S is REAL
+*>           On entry, S specifies the sine, sin.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level1
+*
+*  =====================================================================
+      SUBROUTINE CSROT( N, CX, INCX, CY, INCY, C, S )
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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, INCY, N
+      REAL              C, S
+*     ..
+*     .. Array Arguments ..
+      COMPLEX           CX( * ), CY( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER           I, IX, IY
+      COMPLEX           CTEMP
+*     ..
+*     .. Executable Statements ..
+*
+      IF( N.LE.0 )
+     $   RETURN
+      IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN
+*
+*        code for both increments equal to 1
+*
+         DO I = 1, N
+            CTEMP = C*CX( I ) + S*CY( I )
+            CY( I ) = C*CY( I ) - S*CX( I )
+            CX( I ) = CTEMP
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments not equal
+*          to 1
+*
+         IX = 1
+         IY = 1
+         IF( INCX.LT.0 )
+     $      IX = ( -N+1 )*INCX + 1
+         IF( INCY.LT.0 )
+     $      IY = ( -N+1 )*INCY + 1
+         DO I = 1, N
+            CTEMP = C*CX( IX ) + S*CY( IY )
+            CY( IY ) = C*CY( IY ) - S*CX( IX )
+            CX( IX ) = CTEMP
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/csscal.f

@@ -0,0 +1,94 @@
+*> \brief \b CSSCAL
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSSCAL(N,SA,CX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       REAL SA
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX CX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    CSSCAL scales a complex vector by a real constant.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CSSCAL(N,SA,CX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 SA
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,NINCX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC AIMAG,CMPLX,REAL
+*     ..
+      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+         DO I = 1,N
+            CX(I) = CMPLX(SA*REAL(CX(I)),SA*AIMAG(CX(I)))
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         NINCX = N*INCX
+         DO I = 1,NINCX,INCX
+            CX(I) = CMPLX(SA*REAL(CX(I)),SA*AIMAG(CX(I)))
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/cswap.f

@@ -0,0 +1,98 @@
+*> \brief \b CSWAP
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSWAP(N,CX,INCX,CY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX CX(*),CY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>   CSWAP interchanges two vectors.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CSWAP(N,CX,INCX,CY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*),CY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      COMPLEX CTEMP
+      INTEGER I,IX,IY
+*     ..
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*       code for both increments equal to 1
+         DO I = 1,N
+            CTEMP = CX(I)
+            CX(I) = CY(I)
+            CY(I) = CTEMP
+         END DO
+      ELSE
+*
+*       code for unequal increments or equal increments not equal
+*         to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            CTEMP = CX(IX)
+            CX(IX) = CY(IY)
+            CY(IY) = CTEMP
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/csymm.f

@@ -0,0 +1,369 @@
+*> \brief \b CSYMM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER LDA,LDB,LDC,M,N
+*       CHARACTER SIDE,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CSYMM  performs one of the matrix-matrix operations
+*>
+*>    C := alpha*A*B + beta*C,
+*>
+*> or
+*>
+*>    C := alpha*B*A + beta*C,
+*>
+*> where  alpha and beta are scalars, A is a symmetric matrix and  B and
+*> C are m by n matrices.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>           On entry,  SIDE  specifies whether  the  symmetric matrix  A
+*>           appears on the  left or right  in the  operation as follows:
+*>
+*>              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
+*>
+*>              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*>           triangular  part  of  the  symmetric  matrix   A  is  to  be
+*>           referenced as follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the upper triangular part of the
+*>                                  symmetric matrix is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the lower triangular part of the
+*>                                  symmetric matrix is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry,  M  specifies the number of rows of the matrix  C.
+*>           M  must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix C.
+*>           N  must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*>           m  when  SIDE = 'L' or 'l'  and is n  otherwise.
+*>           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
+*>           the array  A  must contain the  symmetric matrix,  such that
+*>           when  UPLO = 'U' or 'u', the leading m by m upper triangular
+*>           part of the array  A  must contain the upper triangular part
+*>           of the  symmetric matrix and the  strictly  lower triangular
+*>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*>           the leading  m by m  lower triangular part  of the  array  A
+*>           must  contain  the  lower triangular part  of the  symmetric
+*>           matrix and the  strictly upper triangular part of  A  is not
+*>           referenced.
+*>           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
+*>           the array  A  must contain the  symmetric matrix,  such that
+*>           when  UPLO = 'U' or 'u', the leading n by n upper triangular
+*>           part of the array  A  must contain the upper triangular part
+*>           of the  symmetric matrix and the  strictly  lower triangular
+*>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*>           the leading  n by n  lower triangular part  of the  array  A
+*>           must  contain  the  lower triangular part  of the  symmetric
+*>           matrix and the  strictly upper triangular part of  A  is not
+*>           referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the  calling (sub) program. When  SIDE = 'L' or 'l'  then
+*>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*>           least max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          B is COMPLEX array of DIMENSION ( LDB, n ).
+*>           Before entry, the leading  m by n part of the array  B  must
+*>           contain the matrix B.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*>           supplied as zero then C need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array of DIMENSION ( LDC, n ).
+*>           Before entry, the leading  m by n  part of the array  C must
+*>           contain the matrix  C,  except when  beta  is zero, in which
+*>           case C need not be set on entry.
+*>           On exit, the array  C  is overwritten by the  m by n updated
+*>           matrix.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER LDA,LDB,LDC,M,N
+      CHARACTER SIDE,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,J,K,NROWA
+      LOGICAL UPPER
+*     ..
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*
+*     Set NROWA as the number of rows of A.
+*
+      IF (LSAME(SIDE,'L')) THEN
+          NROWA = M
+      ELSE
+          NROWA = N
+      END IF
+      UPPER = LSAME(UPLO,'U')
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 2
+      ELSE IF (M.LT.0) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 7
+      ELSE IF (LDB.LT.MAX(1,M)) THEN
+          INFO = 9
+      ELSE IF (LDC.LT.MAX(1,M)) THEN
+          INFO = 12
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CSYMM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (BETA.EQ.ZERO) THEN
+              DO 20 J = 1,N
+                  DO 10 I = 1,M
+                      C(I,J) = ZERO
+   10             CONTINUE
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  DO 30 I = 1,M
+                      C(I,J) = BETA*C(I,J)
+   30             CONTINUE
+   40         CONTINUE
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSAME(SIDE,'L')) THEN
+*
+*        Form  C := alpha*A*B + beta*C.
+*
+          IF (UPPER) THEN
+              DO 70 J = 1,N
+                  DO 60 I = 1,M
+                      TEMP1 = ALPHA*B(I,J)
+                      TEMP2 = ZERO
+                      DO 50 K = 1,I - 1
+                          C(K,J) = C(K,J) + TEMP1*A(K,I)
+                          TEMP2 = TEMP2 + B(K,J)*A(K,I)
+   50                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
+     +                             ALPHA*TEMP2
+                      END IF
+   60             CONTINUE
+   70         CONTINUE
+          ELSE
+              DO 100 J = 1,N
+                  DO 90 I = M,1,-1
+                      TEMP1 = ALPHA*B(I,J)
+                      TEMP2 = ZERO
+                      DO 80 K = I + 1,M
+                          C(K,J) = C(K,J) + TEMP1*A(K,I)
+                          TEMP2 = TEMP2 + B(K,J)*A(K,I)
+   80                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
+     +                             ALPHA*TEMP2
+                      END IF
+   90             CONTINUE
+  100         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  C := alpha*B*A + beta*C.
+*
+          DO 170 J = 1,N
+              TEMP1 = ALPHA*A(J,J)
+              IF (BETA.EQ.ZERO) THEN
+                  DO 110 I = 1,M
+                      C(I,J) = TEMP1*B(I,J)
+  110             CONTINUE
+              ELSE
+                  DO 120 I = 1,M
+                      C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
+  120             CONTINUE
+              END IF
+              DO 140 K = 1,J - 1
+                  IF (UPPER) THEN
+                      TEMP1 = ALPHA*A(K,J)
+                  ELSE
+                      TEMP1 = ALPHA*A(J,K)
+                  END IF
+                  DO 130 I = 1,M
+                      C(I,J) = C(I,J) + TEMP1*B(I,K)
+  130             CONTINUE
+  140         CONTINUE
+              DO 160 K = J + 1,N
+                  IF (UPPER) THEN
+                      TEMP1 = ALPHA*A(J,K)
+                  ELSE
+                      TEMP1 = ALPHA*A(K,J)
+                  END IF
+                  DO 150 I = 1,M
+                      C(I,J) = C(I,J) + TEMP1*B(I,K)
+  150             CONTINUE
+  160         CONTINUE
+  170     CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of CSYMM .
+*
+      END

lapack-netlib/BLAS/SRC/csyr2k.f

@@ -0,0 +1,396 @@
+*> \brief \b CSYR2K
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER K,LDA,LDB,LDC,N
+*       CHARACTER TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CSYR2K  performs one of the symmetric rank 2k operations
+*>
+*>    C := alpha*A*B**T + alpha*B*A**T + beta*C,
+*>
+*> or
+*>
+*>    C := alpha*A**T*B + alpha*B**T*A + beta*C,
+*>
+*> where  alpha and beta  are scalars,  C is an  n by n symmetric matrix
+*> and  A and B  are  n by k  matrices  in the  first  case  and  k by n
+*> matrices in the second case.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*>           triangular  part  of the  array  C  is to be  referenced  as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry,  TRANS  specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'    C := alpha*A*B**T + alpha*B*A**T +
+*>                                         beta*C.
+*>
+*>              TRANS = 'T' or 't'    C := alpha*A**T*B + alpha*B**T*A +
+*>                                         beta*C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry,  N specifies the order of the matrix C.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*>           of  columns  of the  matrices  A and B,  and on  entry  with
+*>           TRANS = 'T' or 't',  K  specifies  the number of rows of the
+*>           matrices  A and B.  K must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*>           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*>           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*>           part of the array  A  must contain the matrix  A,  otherwise
+*>           the leading  k by n  part of the array  A  must contain  the
+*>           matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*>           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*>           be at least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          B is COMPLEX array of DIMENSION ( LDB, kb ), where kb is
+*>           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*>           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*>           part of the array  B  must contain the matrix  B,  otherwise
+*>           the leading  k by n  part of the array  B  must contain  the
+*>           matrix B.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*>           then  LDB must be at least  max( 1, n ), otherwise  LDB must
+*>           be at least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array of DIMENSION ( LDC, n ).
+*>           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*>           upper triangular part of the array C must contain the upper
+*>           triangular part  of the  symmetric matrix  and the strictly
+*>           lower triangular part of C is not referenced.  On exit, the
+*>           upper triangular part of the array  C is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*>           lower triangular part of the array C must contain the lower
+*>           triangular part  of the  symmetric matrix  and the strictly
+*>           upper triangular part of C is not referenced.  On exit, the
+*>           lower triangular part of the array  C is overwritten by the
+*>           lower triangular part of the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER K,LDA,LDB,LDC,N
+      CHARACTER TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),B(LDB,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP1,TEMP2
+      INTEGER I,INFO,J,L,NROWA
+      LOGICAL UPPER
+*     ..
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*
+*     Test the input parameters.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          NROWA = N
+      ELSE
+          NROWA = K
+      END IF
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
+     +         (.NOT.LSAME(TRANS,'T'))) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (K.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 7
+      ELSE IF (LDB.LT.MAX(1,NROWA)) THEN
+          INFO = 9
+      ELSE IF (LDC.LT.MAX(1,N)) THEN
+          INFO = 12
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CSYR2K',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
+     +    (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (UPPER) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 20 J = 1,N
+                      DO 10 I = 1,J
+                          C(I,J) = ZERO
+   10                 CONTINUE
+   20             CONTINUE
+              ELSE
+                  DO 40 J = 1,N
+                      DO 30 I = 1,J
+                          C(I,J) = BETA*C(I,J)
+   30                 CONTINUE
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (BETA.EQ.ZERO) THEN
+                  DO 60 J = 1,N
+                      DO 50 I = J,N
+                          C(I,J) = ZERO
+   50                 CONTINUE
+   60             CONTINUE
+              ELSE
+                  DO 80 J = 1,N
+                      DO 70 I = J,N
+                          C(I,J) = BETA*C(I,J)
+   70                 CONTINUE
+   80             CONTINUE
+              END IF
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  C := alpha*A*B**T + alpha*B*A**T + C.
+*
+          IF (UPPER) THEN
+              DO 130 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 90 I = 1,J
+                          C(I,J) = ZERO
+   90                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 100 I = 1,J
+                          C(I,J) = BETA*C(I,J)
+  100                 CONTINUE
+                  END IF
+                  DO 120 L = 1,K
+                      IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
+                          TEMP1 = ALPHA*B(J,L)
+                          TEMP2 = ALPHA*A(J,L)
+                          DO 110 I = 1,J
+                              C(I,J) = C(I,J) + A(I,L)*TEMP1 +
+     +                                 B(I,L)*TEMP2
+  110                     CONTINUE
+                      END IF
+  120             CONTINUE
+  130         CONTINUE
+          ELSE
+              DO 180 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 140 I = J,N
+                          C(I,J) = ZERO
+  140                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 150 I = J,N
+                          C(I,J) = BETA*C(I,J)
+  150                 CONTINUE
+                  END IF
+                  DO 170 L = 1,K
+                      IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
+                          TEMP1 = ALPHA*B(J,L)
+                          TEMP2 = ALPHA*A(J,L)
+                          DO 160 I = J,N
+                              C(I,J) = C(I,J) + A(I,L)*TEMP1 +
+     +                                 B(I,L)*TEMP2
+  160                     CONTINUE
+                      END IF
+  170             CONTINUE
+  180         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  C := alpha*A**T*B + alpha*B**T*A + C.
+*
+          IF (UPPER) THEN
+              DO 210 J = 1,N
+                  DO 200 I = 1,J
+                      TEMP1 = ZERO
+                      TEMP2 = ZERO
+                      DO 190 L = 1,K
+                          TEMP1 = TEMP1 + A(L,I)*B(L,J)
+                          TEMP2 = TEMP2 + B(L,I)*A(L,J)
+  190                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
+     +                             ALPHA*TEMP2
+                      END IF
+  200             CONTINUE
+  210         CONTINUE
+          ELSE
+              DO 240 J = 1,N
+                  DO 230 I = J,N
+                      TEMP1 = ZERO
+                      TEMP2 = ZERO
+                      DO 220 L = 1,K
+                          TEMP1 = TEMP1 + A(L,I)*B(L,J)
+                          TEMP2 = TEMP2 + B(L,I)*A(L,J)
+  220                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
+     +                             ALPHA*TEMP2
+                      END IF
+  230             CONTINUE
+  240         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CSYR2K.
+*
+      END

lapack-netlib/BLAS/SRC/csyrk.f

@@ -0,0 +1,363 @@
+*> \brief \b CSYRK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA,BETA
+*       INTEGER K,LDA,LDC,N
+*       CHARACTER TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CSYRK  performs one of the symmetric rank k operations
+*>
+*>    C := alpha*A*A**T + beta*C,
+*>
+*> or
+*>
+*>    C := alpha*A**T*A + beta*C,
+*>
+*> where  alpha and beta  are scalars,  C is an  n by n symmetric matrix
+*> and  A  is an  n by k  matrix in the first case and a  k by n  matrix
+*> in the second case.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*>           triangular  part  of the  array  C  is to be  referenced  as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry,  TRANS  specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   C := alpha*A*A**T + beta*C.
+*>
+*>              TRANS = 'T' or 't'   C := alpha*A**T*A + beta*C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry,  N specifies the order of the matrix C.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*>           of  columns   of  the   matrix   A,   and  on   entry   with
+*>           TRANS = 'T' or 't',  K  specifies  the number of rows of the
+*>           matrix A.  K must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, ka ), where ka is
+*>           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*>           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*>           part of the array  A  must contain the matrix  A,  otherwise
+*>           the leading  k by n  part of the array  A  must contain  the
+*>           matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*>           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*>           be at least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is COMPLEX
+*>           On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array of DIMENSION ( LDC, n ).
+*>           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*>           upper triangular part of the array C must contain the upper
+*>           triangular part  of the  symmetric matrix  and the strictly
+*>           lower triangular part of C is not referenced.  On exit, the
+*>           upper triangular part of the array  C is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*>           lower triangular part of the array C must contain the lower
+*>           triangular part  of the  symmetric matrix  and the strictly
+*>           upper triangular part of C is not referenced.  On exit, the
+*>           lower triangular part of the array  C is overwritten by the
+*>           lower triangular part of the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER K,LDA,LDC,N
+      CHARACTER TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,J,L,NROWA
+      LOGICAL UPPER
+*     ..
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*
+*     Test the input parameters.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          NROWA = N
+      ELSE
+          NROWA = K
+      END IF
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
+     +         (.NOT.LSAME(TRANS,'T'))) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (K.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 7
+      ELSE IF (LDC.LT.MAX(1,N)) THEN
+          INFO = 10
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CSYRK ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
+     +    (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (UPPER) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 20 J = 1,N
+                      DO 10 I = 1,J
+                          C(I,J) = ZERO
+   10                 CONTINUE
+   20             CONTINUE
+              ELSE
+                  DO 40 J = 1,N
+                      DO 30 I = 1,J
+                          C(I,J) = BETA*C(I,J)
+   30                 CONTINUE
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (BETA.EQ.ZERO) THEN
+                  DO 60 J = 1,N
+                      DO 50 I = J,N
+                          C(I,J) = ZERO
+   50                 CONTINUE
+   60             CONTINUE
+              ELSE
+                  DO 80 J = 1,N
+                      DO 70 I = J,N
+                          C(I,J) = BETA*C(I,J)
+   70                 CONTINUE
+   80             CONTINUE
+              END IF
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  C := alpha*A*A**T + beta*C.
+*
+          IF (UPPER) THEN
+              DO 130 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 90 I = 1,J
+                          C(I,J) = ZERO
+   90                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 100 I = 1,J
+                          C(I,J) = BETA*C(I,J)
+  100                 CONTINUE
+                  END IF
+                  DO 120 L = 1,K
+                      IF (A(J,L).NE.ZERO) THEN
+                          TEMP = ALPHA*A(J,L)
+                          DO 110 I = 1,J
+                              C(I,J) = C(I,J) + TEMP*A(I,L)
+  110                     CONTINUE
+                      END IF
+  120             CONTINUE
+  130         CONTINUE
+          ELSE
+              DO 180 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 140 I = J,N
+                          C(I,J) = ZERO
+  140                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 150 I = J,N
+                          C(I,J) = BETA*C(I,J)
+  150                 CONTINUE
+                  END IF
+                  DO 170 L = 1,K
+                      IF (A(J,L).NE.ZERO) THEN
+                          TEMP = ALPHA*A(J,L)
+                          DO 160 I = J,N
+                              C(I,J) = C(I,J) + TEMP*A(I,L)
+  160                     CONTINUE
+                      END IF
+  170             CONTINUE
+  180         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  C := alpha*A**T*A + beta*C.
+*
+          IF (UPPER) THEN
+              DO 210 J = 1,N
+                  DO 200 I = 1,J
+                      TEMP = ZERO
+                      DO 190 L = 1,K
+                          TEMP = TEMP + A(L,I)*A(L,J)
+  190                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  200             CONTINUE
+  210         CONTINUE
+          ELSE
+              DO 240 J = 1,N
+                  DO 230 I = J,N
+                      TEMP = ZERO
+                      DO 220 L = 1,K
+                          TEMP = TEMP + A(L,I)*A(L,J)
+  220                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  230             CONTINUE
+  240         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CSYRK .
+*
+      END

lapack-netlib/BLAS/SRC/ctbmv.f

@@ -0,0 +1,429 @@
+*> \brief \b CTBMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,K,LDA,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTBMV  performs one of the matrix-vector operations
+*>
+*>    x := A*x,   or   x := A**T*x,   or   x := A**H*x,
+*>
+*> where x is an n element vector and  A is an n by n unit, or non-unit,
+*> upper or lower triangular band matrix, with ( k + 1 ) diagonals.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   x := A*x.
+*>
+*>              TRANS = 'T' or 't'   x := A**T*x.
+*>
+*>              TRANS = 'C' or 'c'   x := A**H*x.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with UPLO = 'U' or 'u', K specifies the number of
+*>           super-diagonals of the matrix A.
+*>           On entry with UPLO = 'L' or 'l', K specifies the number of
+*>           sub-diagonals of the matrix A.
+*>           K must satisfy  0 .le. K.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*>           by n part of the array A must contain the upper triangular
+*>           band part of the matrix of coefficients, supplied column by
+*>           column, with the leading diagonal of the matrix in row
+*>           ( k + 1 ) of the array, the first super-diagonal starting at
+*>           position 2 in row k, and so on. The top left k by k triangle
+*>           of the array A is not referenced.
+*>           The following program segment will transfer an upper
+*>           triangular band matrix from conventional full matrix storage
+*>           to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = K + 1 - J
+*>                    DO 10, I = MAX( 1, J - K ), J
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*>           by n part of the array A must contain the lower triangular
+*>           band part of the matrix of coefficients, supplied column by
+*>           column, with the leading diagonal of the matrix in row 1 of
+*>           the array, the first sub-diagonal starting at position 1 in
+*>           row 2, and so on. The bottom right k by k triangle of the
+*>           array A is not referenced.
+*>           The following program segment will transfer a lower
+*>           triangular band matrix from conventional full matrix storage
+*>           to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = 1 - J
+*>                    DO 10, I = J, MIN( N, J + K )
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Note that when DIAG = 'U' or 'u' the elements of the array A
+*>           corresponding to the diagonal elements of the matrix are not
+*>           referenced, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( k + 1 ).
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x. On exit, X is overwritten with the
+*>           tranformed vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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,K,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
+      LOGICAL NOCONJ,NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,MIN
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (K.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT. (K+1)) THEN
+          INFO = 7
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CTBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX   too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*         Form  x := A*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          L = KPLUS1 - J
+                          DO 10 I = MAX(1,J-K),J - 1
+                              X(I) = X(I) + TEMP*A(L+I,J)
+   10                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J)
+                      END IF
+   20             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 40 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          L = KPLUS1 - J
+                          DO 30 I = MAX(1,J-K),J - 1
+                              X(IX) = X(IX) + TEMP*A(L+I,J)
+                              IX = IX + INCX
+   30                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J)
+                      END IF
+                      JX = JX + INCX
+                      IF (J.GT.K) KX = KX + INCX
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          L = 1 - J
+                          DO 50 I = MIN(N,J+K),J + 1,-1
+                              X(I) = X(I) + TEMP*A(L+I,J)
+   50                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(1,J)
+                      END IF
+   60             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 80 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          L = 1 - J
+                          DO 70 I = MIN(N,J+K),J + 1,-1
+                              X(IX) = X(IX) + TEMP*A(L+I,J)
+                              IX = IX - INCX
+   70                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(1,J)
+                      END IF
+                      JX = JX - INCX
+                      IF ((N-J).GE.K) KX = KX - INCX
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := A**T*x  or  x := A**H*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 110 J = N,1,-1
+                      TEMP = X(J)
+                      L = KPLUS1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
+                          DO 90 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + A(L+I,J)*X(I)
+   90                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(KPLUS1,J))
+                          DO 100 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + CONJG(A(L+I,J))*X(I)
+  100                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+  110             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 140 J = N,1,-1
+                      TEMP = X(JX)
+                      KX = KX - INCX
+                      IX = KX
+                      L = KPLUS1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
+                          DO 120 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + A(L+I,J)*X(IX)
+                              IX = IX - INCX
+  120                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(KPLUS1,J))
+                          DO 130 I = J - 1,MAX(1,J-K),-1
+                              TEMP = TEMP + CONJG(A(L+I,J))*X(IX)
+                              IX = IX - INCX
+  130                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX - INCX
+  140             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 170 J = 1,N
+                      TEMP = X(J)
+                      L = 1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(1,J)
+                          DO 150 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + A(L+I,J)*X(I)
+  150                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(1,J))
+                          DO 160 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + CONJG(A(L+I,J))*X(I)
+  160                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+  170             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 200 J = 1,N
+                      TEMP = X(JX)
+                      KX = KX + INCX
+                      IX = KX
+                      L = 1 - J
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(1,J)
+                          DO 180 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + A(L+I,J)*X(IX)
+                              IX = IX + INCX
+  180                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(1,J))
+                          DO 190 I = J + 1,MIN(N,J+K)
+                              TEMP = TEMP + CONJG(A(L+I,J))*X(IX)
+                              IX = IX + INCX
+  190                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX + INCX
+  200             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CTBMV .
+*
+      END

lapack-netlib/BLAS/SRC/ctbsv.f

@@ -0,0 +1,432 @@
+*> \brief \b CTBSV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,K,LDA,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTBSV  solves one of the systems of equations
+*>
+*>    A*x = b,   or   A**T*x = b,   or   A**H*x = b,
+*>
+*> where b and x are n element vectors and A is an n by n unit, or
+*> non-unit, upper or lower triangular band matrix, with ( k + 1 )
+*> diagonals.
+*>
+*> No test for singularity or near-singularity is included in this
+*> routine. Such tests must be performed before calling this routine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the equations to be solved as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   A*x = b.
+*>
+*>              TRANS = 'T' or 't'   A**T*x = b.
+*>
+*>              TRANS = 'C' or 'c'   A**H*x = b.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with UPLO = 'U' or 'u', K specifies the number of
+*>           super-diagonals of the matrix A.
+*>           On entry with UPLO = 'L' or 'l', K specifies the number of
+*>           sub-diagonals of the matrix A.
+*>           K must satisfy  0 .le. K.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*>           by n part of the array A must contain the upper triangular
+*>           band part of the matrix of coefficients, supplied column by
+*>           column, with the leading diagonal of the matrix in row
+*>           ( k + 1 ) of the array, the first super-diagonal starting at
+*>           position 2 in row k, and so on. The top left k by k triangle
+*>           of the array A is not referenced.
+*>           The following program segment will transfer an upper
+*>           triangular band matrix from conventional full matrix storage
+*>           to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = K + 1 - J
+*>                    DO 10, I = MAX( 1, J - K ), J
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*>           by n part of the array A must contain the lower triangular
+*>           band part of the matrix of coefficients, supplied column by
+*>           column, with the leading diagonal of the matrix in row 1 of
+*>           the array, the first sub-diagonal starting at position 1 in
+*>           row 2, and so on. The bottom right k by k triangle of the
+*>           array A is not referenced.
+*>           The following program segment will transfer a lower
+*>           triangular band matrix from conventional full matrix storage
+*>           to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = 1 - J
+*>                    DO 10, I = J, MIN( N, J + K )
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Note that when DIAG = 'U' or 'u' the elements of the array A
+*>           corresponding to the diagonal elements of the matrix are not
+*>           referenced, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( k + 1 ).
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element right-hand side vector b. On exit, X is overwritten
+*>           with the solution vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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,K,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
+      LOGICAL NOCONJ,NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX,MIN
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (K.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT. (K+1)) THEN
+          INFO = 7
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CTBSV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed by sequentially with one pass through A.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x := inv( A )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          L = KPLUS1 - J
+                          IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J)
+                          TEMP = X(J)
+                          DO 10 I = J - 1,MAX(1,J-K),-1
+                              X(I) = X(I) - TEMP*A(L+I,J)
+   10                     CONTINUE
+                      END IF
+   20             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 40 J = N,1,-1
+                      KX = KX - INCX
+                      IF (X(JX).NE.ZERO) THEN
+                          IX = KX
+                          L = KPLUS1 - J
+                          IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J)
+                          TEMP = X(JX)
+                          DO 30 I = J - 1,MAX(1,J-K),-1
+                              X(IX) = X(IX) - TEMP*A(L+I,J)
+                              IX = IX - INCX
+   30                     CONTINUE
+                      END IF
+                      JX = JX - INCX
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          L = 1 - J
+                          IF (NOUNIT) X(J) = X(J)/A(1,J)
+                          TEMP = X(J)
+                          DO 50 I = J + 1,MIN(N,J+K)
+                              X(I) = X(I) - TEMP*A(L+I,J)
+   50                     CONTINUE
+                      END IF
+   60             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 80 J = 1,N
+                      KX = KX + INCX
+                      IF (X(JX).NE.ZERO) THEN
+                          IX = KX
+                          L = 1 - J
+                          IF (NOUNIT) X(JX) = X(JX)/A(1,J)
+                          TEMP = X(JX)
+                          DO 70 I = J + 1,MIN(N,J+K)
+                              X(IX) = X(IX) - TEMP*A(L+I,J)
+                              IX = IX + INCX
+   70                     CONTINUE
+                      END IF
+                      JX = JX + INCX
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := inv( A**T )*x  or  x := inv( A**H )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 110 J = 1,N
+                      TEMP = X(J)
+                      L = KPLUS1 - J
+                      IF (NOCONJ) THEN
+                          DO 90 I = MAX(1,J-K),J - 1
+                              TEMP = TEMP - A(L+I,J)*X(I)
+   90                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
+                      ELSE
+                          DO 100 I = MAX(1,J-K),J - 1
+                              TEMP = TEMP - CONJG(A(L+I,J))*X(I)
+  100                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(A(KPLUS1,J))
+                      END IF
+                      X(J) = TEMP
+  110             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 140 J = 1,N
+                      TEMP = X(JX)
+                      IX = KX
+                      L = KPLUS1 - J
+                      IF (NOCONJ) THEN
+                          DO 120 I = MAX(1,J-K),J - 1
+                              TEMP = TEMP - A(L+I,J)*X(IX)
+                              IX = IX + INCX
+  120                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
+                      ELSE
+                          DO 130 I = MAX(1,J-K),J - 1
+                              TEMP = TEMP - CONJG(A(L+I,J))*X(IX)
+                              IX = IX + INCX
+  130                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(A(KPLUS1,J))
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX + INCX
+                      IF (J.GT.K) KX = KX + INCX
+  140             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 170 J = N,1,-1
+                      TEMP = X(J)
+                      L = 1 - J
+                      IF (NOCONJ) THEN
+                          DO 150 I = MIN(N,J+K),J + 1,-1
+                              TEMP = TEMP - A(L+I,J)*X(I)
+  150                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(1,J)
+                      ELSE
+                          DO 160 I = MIN(N,J+K),J + 1,-1
+                              TEMP = TEMP - CONJG(A(L+I,J))*X(I)
+  160                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(A(1,J))
+                      END IF
+                      X(J) = TEMP
+  170             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 200 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = KX
+                      L = 1 - J
+                      IF (NOCONJ) THEN
+                          DO 180 I = MIN(N,J+K),J + 1,-1
+                              TEMP = TEMP - A(L+I,J)*X(IX)
+                              IX = IX - INCX
+  180                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(1,J)
+                      ELSE
+                          DO 190 I = MIN(N,J+K),J + 1,-1
+                              TEMP = TEMP - CONJG(A(L+I,J))*X(IX)
+                              IX = IX - INCX
+  190                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(A(1,J))
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX - INCX
+                      IF ((N-J).GE.K) KX = KX - INCX
+  200             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CTBSV .
+*
+      END

lapack-netlib/BLAS/SRC/ctpmv.f

@@ -0,0 +1,388 @@
+*> \brief \b CTPMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX AP(*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTPMV  performs one of the matrix-vector operations
+*>
+*>    x := A*x,   or   x := A**T*x,   or   x := A**H*x,
+*>
+*> where x is an n element vector and  A is an n by n unit, or non-unit,
+*> upper or lower triangular matrix, supplied in packed form.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   x := A*x.
+*>
+*>              TRANS = 'T' or 't'   x := A**T*x.
+*>
+*>              TRANS = 'C' or 'c'   x := A**H*x.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] AP
+*> \verbatim
+*>          AP is COMPLEX array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with  UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular matrix packed sequentially,
+*>           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*>           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+*>           respectively, and so on.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular matrix packed sequentially,
+*>           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*>           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+*>           respectively, and so on.
+*>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*>           A are not referenced, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x. On exit, X is overwritten with the
+*>           tranformed vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX AP(*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,K,KK,KX
+      LOGICAL NOCONJ,NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 7
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CTPMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of AP are
+*     accessed sequentially with one pass through AP.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x:= A*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KK = 1
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          K = KK
+                          DO 10 I = 1,J - 1
+                              X(I) = X(I) + TEMP*AP(K)
+                              K = K + 1
+   10                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*AP(KK+J-1)
+                      END IF
+                      KK = KK + J
+   20             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 40 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 30 K = KK,KK + J - 2
+                              X(IX) = X(IX) + TEMP*AP(K)
+                              IX = IX + INCX
+   30                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1)
+                      END IF
+                      JX = JX + INCX
+                      KK = KK + J
+   40             CONTINUE
+              END IF
+          ELSE
+              KK = (N* (N+1))/2
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          K = KK
+                          DO 50 I = N,J + 1,-1
+                              X(I) = X(I) + TEMP*AP(K)
+                              K = K - 1
+   50                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*AP(KK-N+J)
+                      END IF
+                      KK = KK - (N-J+1)
+   60             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 80 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 70 K = KK,KK - (N- (J+1)),-1
+                              X(IX) = X(IX) + TEMP*AP(K)
+                              IX = IX - INCX
+   70                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J)
+                      END IF
+                      JX = JX - INCX
+                      KK = KK - (N-J+1)
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := A**T*x  or  x := A**H*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KK = (N* (N+1))/2
+              IF (INCX.EQ.1) THEN
+                  DO 110 J = N,1,-1
+                      TEMP = X(J)
+                      K = KK - 1
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*AP(KK)
+                          DO 90 I = J - 1,1,-1
+                              TEMP = TEMP + AP(K)*X(I)
+                              K = K - 1
+   90                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(AP(KK))
+                          DO 100 I = J - 1,1,-1
+                              TEMP = TEMP + CONJG(AP(K))*X(I)
+                              K = K - 1
+  100                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+                      KK = KK - J
+  110             CONTINUE
+              ELSE
+                  JX = KX + (N-1)*INCX
+                  DO 140 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*AP(KK)
+                          DO 120 K = KK - 1,KK - J + 1,-1
+                              IX = IX - INCX
+                              TEMP = TEMP + AP(K)*X(IX)
+  120                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(AP(KK))
+                          DO 130 K = KK - 1,KK - J + 1,-1
+                              IX = IX - INCX
+                              TEMP = TEMP + CONJG(AP(K))*X(IX)
+  130                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX - INCX
+                      KK = KK - J
+  140             CONTINUE
+              END IF
+          ELSE
+              KK = 1
+              IF (INCX.EQ.1) THEN
+                  DO 170 J = 1,N
+                      TEMP = X(J)
+                      K = KK + 1
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*AP(KK)
+                          DO 150 I = J + 1,N
+                              TEMP = TEMP + AP(K)*X(I)
+                              K = K + 1
+  150                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(AP(KK))
+                          DO 160 I = J + 1,N
+                              TEMP = TEMP + CONJG(AP(K))*X(I)
+                              K = K + 1
+  160                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+                      KK = KK + (N-J+1)
+  170             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 200 J = 1,N
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*AP(KK)
+                          DO 180 K = KK + 1,KK + N - J
+                              IX = IX + INCX
+                              TEMP = TEMP + AP(K)*X(IX)
+  180                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(AP(KK))
+                          DO 190 K = KK + 1,KK + N - J
+                              IX = IX + INCX
+                              TEMP = TEMP + CONJG(AP(K))*X(IX)
+  190                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX + INCX
+                      KK = KK + (N-J+1)
+  200             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CTPMV .
+*
+      END

lapack-netlib/BLAS/SRC/ctpsv.f

@@ -0,0 +1,390 @@
+*> \brief \b CTPSV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX AP(*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTPSV  solves one of the systems of equations
+*>
+*>    A*x = b,   or   A**T*x = b,   or   A**H*x = b,
+*>
+*> where b and x are n element vectors and A is an n by n unit, or
+*> non-unit, upper or lower triangular matrix, supplied in packed form.
+*>
+*> No test for singularity or near-singularity is included in this
+*> routine. Such tests must be performed before calling this routine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the equations to be solved as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   A*x = b.
+*>
+*>              TRANS = 'T' or 't'   A**T*x = b.
+*>
+*>              TRANS = 'C' or 'c'   A**H*x = b.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] AP
+*> \verbatim
+*>          AP is COMPLEX array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with  UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular matrix packed sequentially,
+*>           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*>           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+*>           respectively, and so on.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular matrix packed sequentially,
+*>           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*>           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+*>           respectively, and so on.
+*>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*>           A are not referenced, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element right-hand side vector b. On exit, X is overwritten
+*>           with the solution vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX AP(*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,K,KK,KX
+      LOGICAL NOCONJ,NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 7
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CTPSV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of AP are
+*     accessed sequentially with one pass through AP.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x := inv( A )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KK = (N* (N+1))/2
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          IF (NOUNIT) X(J) = X(J)/AP(KK)
+                          TEMP = X(J)
+                          K = KK - 1
+                          DO 10 I = J - 1,1,-1
+                              X(I) = X(I) - TEMP*AP(K)
+                              K = K - 1
+   10                     CONTINUE
+                      END IF
+                      KK = KK - J
+   20             CONTINUE
+              ELSE
+                  JX = KX + (N-1)*INCX
+                  DO 40 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          IF (NOUNIT) X(JX) = X(JX)/AP(KK)
+                          TEMP = X(JX)
+                          IX = JX
+                          DO 30 K = KK - 1,KK - J + 1,-1
+                              IX = IX - INCX
+                              X(IX) = X(IX) - TEMP*AP(K)
+   30                     CONTINUE
+                      END IF
+                      JX = JX - INCX
+                      KK = KK - J
+   40             CONTINUE
+              END IF
+          ELSE
+              KK = 1
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          IF (NOUNIT) X(J) = X(J)/AP(KK)
+                          TEMP = X(J)
+                          K = KK + 1
+                          DO 50 I = J + 1,N
+                              X(I) = X(I) - TEMP*AP(K)
+                              K = K + 1
+   50                     CONTINUE
+                      END IF
+                      KK = KK + (N-J+1)
+   60             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 80 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          IF (NOUNIT) X(JX) = X(JX)/AP(KK)
+                          TEMP = X(JX)
+                          IX = JX
+                          DO 70 K = KK + 1,KK + N - J
+                              IX = IX + INCX
+                              X(IX) = X(IX) - TEMP*AP(K)
+   70                     CONTINUE
+                      END IF
+                      JX = JX + INCX
+                      KK = KK + (N-J+1)
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := inv( A**T )*x  or  x := inv( A**H )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KK = 1
+              IF (INCX.EQ.1) THEN
+                  DO 110 J = 1,N
+                      TEMP = X(J)
+                      K = KK
+                      IF (NOCONJ) THEN
+                          DO 90 I = 1,J - 1
+                              TEMP = TEMP - AP(K)*X(I)
+                              K = K + 1
+   90                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/AP(KK+J-1)
+                      ELSE
+                          DO 100 I = 1,J - 1
+                              TEMP = TEMP - CONJG(AP(K))*X(I)
+                              K = K + 1
+  100                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(AP(KK+J-1))
+                      END IF
+                      X(J) = TEMP
+                      KK = KK + J
+  110             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 140 J = 1,N
+                      TEMP = X(JX)
+                      IX = KX
+                      IF (NOCONJ) THEN
+                          DO 120 K = KK,KK + J - 2
+                              TEMP = TEMP - AP(K)*X(IX)
+                              IX = IX + INCX
+  120                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/AP(KK+J-1)
+                      ELSE
+                          DO 130 K = KK,KK + J - 2
+                              TEMP = TEMP - CONJG(AP(K))*X(IX)
+                              IX = IX + INCX
+  130                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(AP(KK+J-1))
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX + INCX
+                      KK = KK + J
+  140             CONTINUE
+              END IF
+          ELSE
+              KK = (N* (N+1))/2
+              IF (INCX.EQ.1) THEN
+                  DO 170 J = N,1,-1
+                      TEMP = X(J)
+                      K = KK
+                      IF (NOCONJ) THEN
+                          DO 150 I = N,J + 1,-1
+                              TEMP = TEMP - AP(K)*X(I)
+                              K = K - 1
+  150                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/AP(KK-N+J)
+                      ELSE
+                          DO 160 I = N,J + 1,-1
+                              TEMP = TEMP - CONJG(AP(K))*X(I)
+                              K = K - 1
+  160                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(AP(KK-N+J))
+                      END IF
+                      X(J) = TEMP
+                      KK = KK - (N-J+1)
+  170             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 200 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = KX
+                      IF (NOCONJ) THEN
+                          DO 180 K = KK,KK - (N- (J+1)),-1
+                              TEMP = TEMP - AP(K)*X(IX)
+                              IX = IX - INCX
+  180                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/AP(KK-N+J)
+                      ELSE
+                          DO 190 K = KK,KK - (N- (J+1)),-1
+                              TEMP = TEMP - CONJG(AP(K))*X(IX)
+                              IX = IX - INCX
+  190                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(AP(KK-N+J))
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX - INCX
+                      KK = KK - (N-J+1)
+  200             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CTPSV .
+*
+      END

lapack-netlib/BLAS/SRC/ctrmm.f

@@ -0,0 +1,452 @@
+*> \brief \b CTRMM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA
+*       INTEGER LDA,LDB,M,N
+*       CHARACTER DIAG,SIDE,TRANSA,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),B(LDB,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTRMM  performs one of the matrix-matrix operations
+*>
+*>    B := alpha*op( A )*B,   or   B := alpha*B*op( A )
+*>
+*> where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
+*> non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
+*>
+*>    op( A ) = A   or   op( A ) = A**T   or   op( A ) = A**H.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>           On entry,  SIDE specifies whether  op( A ) multiplies B from
+*>           the left or right as follows:
+*>
+*>              SIDE = 'L' or 'l'   B := alpha*op( A )*B.
+*>
+*>              SIDE = 'R' or 'r'   B := alpha*B*op( A ).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix A is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANSA
+*> \verbatim
+*>          TRANSA is CHARACTER*1
+*>           On entry, TRANSA specifies the form of op( A ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSA = 'N' or 'n'   op( A ) = A.
+*>
+*>              TRANSA = 'T' or 't'   op( A ) = A**T.
+*>
+*>              TRANSA = 'C' or 'c'   op( A ) = A**H.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit triangular
+*>           as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of B. M must be at
+*>           least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of B.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
+*>           zero then  A is not referenced and  B need not be set before
+*>           entry.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, k ), where k is m
+*>           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
+*>           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
+*>           upper triangular part of the array  A must contain the upper
+*>           triangular matrix  and the strictly lower triangular part of
+*>           A is not referenced.
+*>           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
+*>           lower triangular part of the array  A must contain the lower
+*>           triangular matrix  and the strictly upper triangular part of
+*>           A is not referenced.
+*>           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
+*>           A  are not referenced either,  but are assumed to be  unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*>           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
+*>           then LDA must be at least max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array of DIMENSION ( LDB, n ).
+*>           Before entry,  the leading  m by n part of the array  B must
+*>           contain the matrix  B,  and  on exit  is overwritten  by the
+*>           transformed matrix.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER LDA,LDB,M,N
+      CHARACTER DIAG,SIDE,TRANSA,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),B(LDB,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,J,K,NROWA
+      LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
+*     ..
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*
+*     Test the input parameters.
+*
+      LSIDE = LSAME(SIDE,'L')
+      IF (LSIDE) THEN
+          NROWA = M
+      ELSE
+          NROWA = N
+      END IF
+      NOCONJ = LSAME(TRANSA,'T')
+      NOUNIT = LSAME(DIAG,'N')
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 2
+      ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
+     +         (.NOT.LSAME(TRANSA,'T')) .AND.
+     +         (.NOT.LSAME(TRANSA,'C'))) THEN
+          INFO = 3
+      ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
+          INFO = 4
+      ELSE IF (M.LT.0) THEN
+          INFO = 5
+      ELSE IF (N.LT.0) THEN
+          INFO = 6
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 9
+      ELSE IF (LDB.LT.MAX(1,M)) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CTRMM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (M.EQ.0 .OR. N.EQ.0) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          DO 20 J = 1,N
+              DO 10 I = 1,M
+                  B(I,J) = ZERO
+   10         CONTINUE
+   20     CONTINUE
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSIDE) THEN
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*A*B.
+*
+              IF (UPPER) THEN
+                  DO 50 J = 1,N
+                      DO 40 K = 1,M
+                          IF (B(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*B(K,J)
+                              DO 30 I = 1,K - 1
+                                  B(I,J) = B(I,J) + TEMP*A(I,K)
+   30                         CONTINUE
+                              IF (NOUNIT) TEMP = TEMP*A(K,K)
+                              B(K,J) = TEMP
+                          END IF
+   40                 CONTINUE
+   50             CONTINUE
+              ELSE
+                  DO 80 J = 1,N
+                      DO 70 K = M,1,-1
+                          IF (B(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*B(K,J)
+                              B(K,J) = TEMP
+                              IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
+                              DO 60 I = K + 1,M
+                                  B(I,J) = B(I,J) + TEMP*A(I,K)
+   60                         CONTINUE
+                          END IF
+   70                 CONTINUE
+   80             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*A**T*B   or   B := alpha*A**H*B.
+*
+              IF (UPPER) THEN
+                  DO 120 J = 1,N
+                      DO 110 I = M,1,-1
+                          TEMP = B(I,J)
+                          IF (NOCONJ) THEN
+                              IF (NOUNIT) TEMP = TEMP*A(I,I)
+                              DO 90 K = 1,I - 1
+                                  TEMP = TEMP + A(K,I)*B(K,J)
+   90                         CONTINUE
+                          ELSE
+                              IF (NOUNIT) TEMP = TEMP*CONJG(A(I,I))
+                              DO 100 K = 1,I - 1
+                                  TEMP = TEMP + CONJG(A(K,I))*B(K,J)
+  100                         CONTINUE
+                          END IF
+                          B(I,J) = ALPHA*TEMP
+  110                 CONTINUE
+  120             CONTINUE
+              ELSE
+                  DO 160 J = 1,N
+                      DO 150 I = 1,M
+                          TEMP = B(I,J)
+                          IF (NOCONJ) THEN
+                              IF (NOUNIT) TEMP = TEMP*A(I,I)
+                              DO 130 K = I + 1,M
+                                  TEMP = TEMP + A(K,I)*B(K,J)
+  130                         CONTINUE
+                          ELSE
+                              IF (NOUNIT) TEMP = TEMP*CONJG(A(I,I))
+                              DO 140 K = I + 1,M
+                                  TEMP = TEMP + CONJG(A(K,I))*B(K,J)
+  140                         CONTINUE
+                          END IF
+                          B(I,J) = ALPHA*TEMP
+  150                 CONTINUE
+  160             CONTINUE
+              END IF
+          END IF
+      ELSE
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*B*A.
+*
+              IF (UPPER) THEN
+                  DO 200 J = N,1,-1
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 170 I = 1,M
+                          B(I,J) = TEMP*B(I,J)
+  170                 CONTINUE
+                      DO 190 K = 1,J - 1
+                          IF (A(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*A(K,J)
+                              DO 180 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  180                         CONTINUE
+                          END IF
+  190                 CONTINUE
+  200             CONTINUE
+              ELSE
+                  DO 240 J = 1,N
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 210 I = 1,M
+                          B(I,J) = TEMP*B(I,J)
+  210                 CONTINUE
+                      DO 230 K = J + 1,N
+                          IF (A(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*A(K,J)
+                              DO 220 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  220                         CONTINUE
+                          END IF
+  230                 CONTINUE
+  240             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*B*A**T   or   B := alpha*B*A**H.
+*
+              IF (UPPER) THEN
+                  DO 280 K = 1,N
+                      DO 260 J = 1,K - 1
+                          IF (A(J,K).NE.ZERO) THEN
+                              IF (NOCONJ) THEN
+                                  TEMP = ALPHA*A(J,K)
+                              ELSE
+                                  TEMP = ALPHA*CONJG(A(J,K))
+                              END IF
+                              DO 250 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  250                         CONTINUE
+                          END IF
+  260                 CONTINUE
+                      TEMP = ALPHA
+                      IF (NOUNIT) THEN
+                          IF (NOCONJ) THEN
+                              TEMP = TEMP*A(K,K)
+                          ELSE
+                              TEMP = TEMP*CONJG(A(K,K))
+                          END IF
+                      END IF
+                      IF (TEMP.NE.ONE) THEN
+                          DO 270 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  270                     CONTINUE
+                      END IF
+  280             CONTINUE
+              ELSE
+                  DO 320 K = N,1,-1
+                      DO 300 J = K + 1,N
+                          IF (A(J,K).NE.ZERO) THEN
+                              IF (NOCONJ) THEN
+                                  TEMP = ALPHA*A(J,K)
+                              ELSE
+                                  TEMP = ALPHA*CONJG(A(J,K))
+                              END IF
+                              DO 290 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  290                         CONTINUE
+                          END IF
+  300                 CONTINUE
+                      TEMP = ALPHA
+                      IF (NOUNIT) THEN
+                          IF (NOCONJ) THEN
+                              TEMP = TEMP*A(K,K)
+                          ELSE
+                              TEMP = TEMP*CONJG(A(K,K))
+                          END IF
+                      END IF
+                      IF (TEMP.NE.ONE) THEN
+                          DO 310 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  310                     CONTINUE
+                      END IF
+  320             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CTRMM .
+*
+      END

lapack-netlib/BLAS/SRC/ctrmv.f

@@ -0,0 +1,373 @@
+*> \brief \b CTRMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,LDA,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTRMV  performs one of the matrix-vector operations
+*>
+*>    x := A*x,   or   x := A**T*x,   or   x := A**H*x,
+*>
+*> where x is an n element vector and  A is an n by n unit, or non-unit,
+*> upper or lower triangular matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   x := A*x.
+*>
+*>              TRANS = 'T' or 't'   x := A**T*x.
+*>
+*>              TRANS = 'C' or 'c'   x := A**H*x.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular matrix and the strictly lower triangular part of
+*>           A is not referenced.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular matrix and the strictly upper triangular part of
+*>           A is not referenced.
+*>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*>           A are not referenced either, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x. On exit, X is overwritten with the
+*>           tranformed vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,KX
+      LOGICAL NOCONJ,NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CTRMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x := A*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          DO 10 I = 1,J - 1
+                              X(I) = X(I) + TEMP*A(I,J)
+   10                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(J,J)
+                      END IF
+   20             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 40 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 30 I = 1,J - 1
+                              X(IX) = X(IX) + TEMP*A(I,J)
+                              IX = IX + INCX
+   30                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(J,J)
+                      END IF
+                      JX = JX + INCX
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          DO 50 I = N,J + 1,-1
+                              X(I) = X(I) + TEMP*A(I,J)
+   50                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(J,J)
+                      END IF
+   60             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 80 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 70 I = N,J + 1,-1
+                              X(IX) = X(IX) + TEMP*A(I,J)
+                              IX = IX - INCX
+   70                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(J,J)
+                      END IF
+                      JX = JX - INCX
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := A**T*x  or  x := A**H*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 110 J = N,1,-1
+                      TEMP = X(J)
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(J,J)
+                          DO 90 I = J - 1,1,-1
+                              TEMP = TEMP + A(I,J)*X(I)
+   90                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(J,J))
+                          DO 100 I = J - 1,1,-1
+                              TEMP = TEMP + CONJG(A(I,J))*X(I)
+  100                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+  110             CONTINUE
+              ELSE
+                  JX = KX + (N-1)*INCX
+                  DO 140 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(J,J)
+                          DO 120 I = J - 1,1,-1
+                              IX = IX - INCX
+                              TEMP = TEMP + A(I,J)*X(IX)
+  120                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(J,J))
+                          DO 130 I = J - 1,1,-1
+                              IX = IX - INCX
+                              TEMP = TEMP + CONJG(A(I,J))*X(IX)
+  130                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX - INCX
+  140             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 170 J = 1,N
+                      TEMP = X(J)
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(J,J)
+                          DO 150 I = J + 1,N
+                              TEMP = TEMP + A(I,J)*X(I)
+  150                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(J,J))
+                          DO 160 I = J + 1,N
+                              TEMP = TEMP + CONJG(A(I,J))*X(I)
+  160                     CONTINUE
+                      END IF
+                      X(J) = TEMP
+  170             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 200 J = 1,N
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOCONJ) THEN
+                          IF (NOUNIT) TEMP = TEMP*A(J,J)
+                          DO 180 I = J + 1,N
+                              IX = IX + INCX
+                              TEMP = TEMP + A(I,J)*X(IX)
+  180                     CONTINUE
+                      ELSE
+                          IF (NOUNIT) TEMP = TEMP*CONJG(A(J,J))
+                          DO 190 I = J + 1,N
+                              IX = IX + INCX
+                              TEMP = TEMP + CONJG(A(I,J))*X(IX)
+  190                     CONTINUE
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX + INCX
+  200             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CTRMV .
+*
+      END

lapack-netlib/BLAS/SRC/ctrsm.f

@@ -0,0 +1,477 @@
+*> \brief \b CTRSM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX ALPHA
+*       INTEGER LDA,LDB,M,N
+*       CHARACTER DIAG,SIDE,TRANSA,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),B(LDB,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTRSM  solves one of the matrix equations
+*>
+*>    op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,
+*>
+*> where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+*> non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
+*>
+*>    op( A ) = A   or   op( A ) = A**T   or   op( A ) = A**H.
+*>
+*> The matrix X is overwritten on B.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>           On entry, SIDE specifies whether op( A ) appears on the left
+*>           or right of X as follows:
+*>
+*>              SIDE = 'L' or 'l'   op( A )*X = alpha*B.
+*>
+*>              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix A is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANSA
+*> \verbatim
+*>          TRANSA is CHARACTER*1
+*>           On entry, TRANSA specifies the form of op( A ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSA = 'N' or 'n'   op( A ) = A.
+*>
+*>              TRANSA = 'T' or 't'   op( A ) = A**T.
+*>
+*>              TRANSA = 'C' or 'c'   op( A ) = A**H.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit triangular
+*>           as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of B. M must be at
+*>           least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of B.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is COMPLEX
+*>           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
+*>           zero then  A is not referenced and  B need not be set before
+*>           entry.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, k ),
+*>           where k is m when SIDE = 'L' or 'l'  
+*>             and k is n when SIDE = 'R' or 'r'.
+*>           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
+*>           upper triangular part of the array  A must contain the upper
+*>           triangular matrix  and the strictly lower triangular part of
+*>           A is not referenced.
+*>           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
+*>           lower triangular part of the array  A must contain the lower
+*>           triangular matrix  and the strictly upper triangular part of
+*>           A is not referenced.
+*>           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
+*>           A  are not referenced either,  but are assumed to be  unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*>           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
+*>           then LDA must be at least max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array of DIMENSION ( LDB, n ).
+*>           Before entry,  the leading  m by n part of the array  B must
+*>           contain  the  right-hand  side  matrix  B,  and  on exit  is
+*>           overwritten by the solution matrix  X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER LDA,LDB,M,N
+      CHARACTER DIAG,SIDE,TRANSA,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),B(LDB,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,J,K,NROWA
+      LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
+*     ..
+*     .. Parameters ..
+      COMPLEX ONE
+      PARAMETER (ONE= (1.0E+0,0.0E+0))
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*
+*     Test the input parameters.
+*
+      LSIDE = LSAME(SIDE,'L')
+      IF (LSIDE) THEN
+          NROWA = M
+      ELSE
+          NROWA = N
+      END IF
+      NOCONJ = LSAME(TRANSA,'T')
+      NOUNIT = LSAME(DIAG,'N')
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 2
+      ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
+     +         (.NOT.LSAME(TRANSA,'T')) .AND.
+     +         (.NOT.LSAME(TRANSA,'C'))) THEN
+          INFO = 3
+      ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
+          INFO = 4
+      ELSE IF (M.LT.0) THEN
+          INFO = 5
+      ELSE IF (N.LT.0) THEN
+          INFO = 6
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 9
+      ELSE IF (LDB.LT.MAX(1,M)) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CTRSM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (M.EQ.0 .OR. N.EQ.0) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          DO 20 J = 1,N
+              DO 10 I = 1,M
+                  B(I,J) = ZERO
+   10         CONTINUE
+   20     CONTINUE
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSIDE) THEN
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*inv( A )*B.
+*
+              IF (UPPER) THEN
+                  DO 60 J = 1,N
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 30 I = 1,M
+                              B(I,J) = ALPHA*B(I,J)
+   30                     CONTINUE
+                      END IF
+                      DO 50 K = M,1,-1
+                          IF (B(K,J).NE.ZERO) THEN
+                              IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
+                              DO 40 I = 1,K - 1
+                                  B(I,J) = B(I,J) - B(K,J)*A(I,K)
+   40                         CONTINUE
+                          END IF
+   50                 CONTINUE
+   60             CONTINUE
+              ELSE
+                  DO 100 J = 1,N
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 70 I = 1,M
+                              B(I,J) = ALPHA*B(I,J)
+   70                     CONTINUE
+                      END IF
+                      DO 90 K = 1,M
+                          IF (B(K,J).NE.ZERO) THEN
+                              IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
+                              DO 80 I = K + 1,M
+                                  B(I,J) = B(I,J) - B(K,J)*A(I,K)
+   80                         CONTINUE
+                          END IF
+   90                 CONTINUE
+  100             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*inv( A**T )*B
+*           or    B := alpha*inv( A**H )*B.
+*
+              IF (UPPER) THEN
+                  DO 140 J = 1,N
+                      DO 130 I = 1,M
+                          TEMP = ALPHA*B(I,J)
+                          IF (NOCONJ) THEN
+                              DO 110 K = 1,I - 1
+                                  TEMP = TEMP - A(K,I)*B(K,J)
+  110                         CONTINUE
+                              IF (NOUNIT) TEMP = TEMP/A(I,I)
+                          ELSE
+                              DO 120 K = 1,I - 1
+                                  TEMP = TEMP - CONJG(A(K,I))*B(K,J)
+  120                         CONTINUE
+                              IF (NOUNIT) TEMP = TEMP/CONJG(A(I,I))
+                          END IF
+                          B(I,J) = TEMP
+  130                 CONTINUE
+  140             CONTINUE
+              ELSE
+                  DO 180 J = 1,N
+                      DO 170 I = M,1,-1
+                          TEMP = ALPHA*B(I,J)
+                          IF (NOCONJ) THEN
+                              DO 150 K = I + 1,M
+                                  TEMP = TEMP - A(K,I)*B(K,J)
+  150                         CONTINUE
+                              IF (NOUNIT) TEMP = TEMP/A(I,I)
+                          ELSE
+                              DO 160 K = I + 1,M
+                                  TEMP = TEMP - CONJG(A(K,I))*B(K,J)
+  160                         CONTINUE
+                              IF (NOUNIT) TEMP = TEMP/CONJG(A(I,I))
+                          END IF
+                          B(I,J) = TEMP
+  170                 CONTINUE
+  180             CONTINUE
+              END IF
+          END IF
+      ELSE
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*B*inv( A ).
+*
+              IF (UPPER) THEN
+                  DO 230 J = 1,N
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 190 I = 1,M
+                              B(I,J) = ALPHA*B(I,J)
+  190                     CONTINUE
+                      END IF
+                      DO 210 K = 1,J - 1
+                          IF (A(K,J).NE.ZERO) THEN
+                              DO 200 I = 1,M
+                                  B(I,J) = B(I,J) - A(K,J)*B(I,K)
+  200                         CONTINUE
+                          END IF
+  210                 CONTINUE
+                      IF (NOUNIT) THEN
+                          TEMP = ONE/A(J,J)
+                          DO 220 I = 1,M
+                              B(I,J) = TEMP*B(I,J)
+  220                     CONTINUE
+                      END IF
+  230             CONTINUE
+              ELSE
+                  DO 280 J = N,1,-1
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 240 I = 1,M
+                              B(I,J) = ALPHA*B(I,J)
+  240                     CONTINUE
+                      END IF
+                      DO 260 K = J + 1,N
+                          IF (A(K,J).NE.ZERO) THEN
+                              DO 250 I = 1,M
+                                  B(I,J) = B(I,J) - A(K,J)*B(I,K)
+  250                         CONTINUE
+                          END IF
+  260                 CONTINUE
+                      IF (NOUNIT) THEN
+                          TEMP = ONE/A(J,J)
+                          DO 270 I = 1,M
+                              B(I,J) = TEMP*B(I,J)
+  270                     CONTINUE
+                      END IF
+  280             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*B*inv( A**T )
+*           or    B := alpha*B*inv( A**H ).
+*
+              IF (UPPER) THEN
+                  DO 330 K = N,1,-1
+                      IF (NOUNIT) THEN
+                          IF (NOCONJ) THEN
+                              TEMP = ONE/A(K,K)
+                          ELSE
+                              TEMP = ONE/CONJG(A(K,K))
+                          END IF
+                          DO 290 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  290                     CONTINUE
+                      END IF
+                      DO 310 J = 1,K - 1
+                          IF (A(J,K).NE.ZERO) THEN
+                              IF (NOCONJ) THEN
+                                  TEMP = A(J,K)
+                              ELSE
+                                  TEMP = CONJG(A(J,K))
+                              END IF
+                              DO 300 I = 1,M
+                                  B(I,J) = B(I,J) - TEMP*B(I,K)
+  300                         CONTINUE
+                          END IF
+  310                 CONTINUE
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 320 I = 1,M
+                              B(I,K) = ALPHA*B(I,K)
+  320                     CONTINUE
+                      END IF
+  330             CONTINUE
+              ELSE
+                  DO 380 K = 1,N
+                      IF (NOUNIT) THEN
+                          IF (NOCONJ) THEN
+                              TEMP = ONE/A(K,K)
+                          ELSE
+                              TEMP = ONE/CONJG(A(K,K))
+                          END IF
+                          DO 340 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  340                     CONTINUE
+                      END IF
+                      DO 360 J = K + 1,N
+                          IF (A(J,K).NE.ZERO) THEN
+                              IF (NOCONJ) THEN
+                                  TEMP = A(J,K)
+                              ELSE
+                                  TEMP = CONJG(A(J,K))
+                              END IF
+                              DO 350 I = 1,M
+                                  B(I,J) = B(I,J) - TEMP*B(I,K)
+  350                         CONTINUE
+                          END IF
+  360                 CONTINUE
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 370 I = 1,M
+                              B(I,K) = ALPHA*B(I,K)
+  370                     CONTINUE
+                      END IF
+  380             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CTRSM .
+*
+      END

lapack-netlib/BLAS/SRC/ctrsv.f

@@ -0,0 +1,375 @@
+*> \brief \b CTRSV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,LDA,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTRSV  solves one of the systems of equations
+*>
+*>    A*x = b,   or   A**T*x = b,   or   A**H*x = b,
+*>
+*> where b and x are n element vectors and A is an n by n unit, or
+*> non-unit, upper or lower triangular matrix.
+*>
+*> No test for singularity or near-singularity is included in this
+*> routine. Such tests must be performed before calling this routine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the equations to be solved as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   A*x = b.
+*>
+*>              TRANS = 'T' or 't'   A**T*x = b.
+*>
+*>              TRANS = 'C' or 'c'   A**H*x = b.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is COMPLEX array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular matrix and the strictly lower triangular part of
+*>           A is not referenced.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular matrix and the strictly upper triangular part of
+*>           A is not referenced.
+*>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*>           A are not referenced either, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is COMPLEX array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element right-hand side vector b. On exit, X is overwritten
+*>           with the solution vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup complex_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX ZERO
+      PARAMETER (ZERO= (0.0E+0,0.0E+0))
+*     ..
+*     .. Local Scalars ..
+      COMPLEX TEMP
+      INTEGER I,INFO,IX,J,JX,KX
+      LOGICAL NOCONJ,NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC CONJG,MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('CTRSV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOCONJ = LSAME(TRANS,'T')
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x := inv( A )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          IF (NOUNIT) X(J) = X(J)/A(J,J)
+                          TEMP = X(J)
+                          DO 10 I = J - 1,1,-1
+                              X(I) = X(I) - TEMP*A(I,J)
+   10                     CONTINUE
+                      END IF
+   20             CONTINUE
+              ELSE
+                  JX = KX + (N-1)*INCX
+                  DO 40 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          IF (NOUNIT) X(JX) = X(JX)/A(J,J)
+                          TEMP = X(JX)
+                          IX = JX
+                          DO 30 I = J - 1,1,-1
+                              IX = IX - INCX
+                              X(IX) = X(IX) - TEMP*A(I,J)
+   30                     CONTINUE
+                      END IF
+                      JX = JX - INCX
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          IF (NOUNIT) X(J) = X(J)/A(J,J)
+                          TEMP = X(J)
+                          DO 50 I = J + 1,N
+                              X(I) = X(I) - TEMP*A(I,J)
+   50                     CONTINUE
+                      END IF
+   60             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 80 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          IF (NOUNIT) X(JX) = X(JX)/A(J,J)
+                          TEMP = X(JX)
+                          IX = JX
+                          DO 70 I = J + 1,N
+                              IX = IX + INCX
+                              X(IX) = X(IX) - TEMP*A(I,J)
+   70                     CONTINUE
+                      END IF
+                      JX = JX + INCX
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := inv( A**T )*x  or  x := inv( A**H )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 110 J = 1,N
+                      TEMP = X(J)
+                      IF (NOCONJ) THEN
+                          DO 90 I = 1,J - 1
+                              TEMP = TEMP - A(I,J)*X(I)
+   90                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(J,J)
+                      ELSE
+                          DO 100 I = 1,J - 1
+                              TEMP = TEMP - CONJG(A(I,J))*X(I)
+  100                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(A(J,J))
+                      END IF
+                      X(J) = TEMP
+  110             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 140 J = 1,N
+                      IX = KX
+                      TEMP = X(JX)
+                      IF (NOCONJ) THEN
+                          DO 120 I = 1,J - 1
+                              TEMP = TEMP - A(I,J)*X(IX)
+                              IX = IX + INCX
+  120                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(J,J)
+                      ELSE
+                          DO 130 I = 1,J - 1
+                              TEMP = TEMP - CONJG(A(I,J))*X(IX)
+                              IX = IX + INCX
+  130                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(A(J,J))
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX + INCX
+  140             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 170 J = N,1,-1
+                      TEMP = X(J)
+                      IF (NOCONJ) THEN
+                          DO 150 I = N,J + 1,-1
+                              TEMP = TEMP - A(I,J)*X(I)
+  150                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(J,J)
+                      ELSE
+                          DO 160 I = N,J + 1,-1
+                              TEMP = TEMP - CONJG(A(I,J))*X(I)
+  160                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(A(J,J))
+                      END IF
+                      X(J) = TEMP
+  170             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 200 J = N,1,-1
+                      IX = KX
+                      TEMP = X(JX)
+                      IF (NOCONJ) THEN
+                          DO 180 I = N,J + 1,-1
+                              TEMP = TEMP - A(I,J)*X(IX)
+                              IX = IX - INCX
+  180                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(J,J)
+                      ELSE
+                          DO 190 I = N,J + 1,-1
+                              TEMP = TEMP - CONJG(A(I,J))*X(IX)
+                              IX = IX - INCX
+  190                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/CONJG(A(J,J))
+                      END IF
+                      X(JX) = TEMP
+                      JX = JX - INCX
+  200             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of CTRSV .
+*
+      END

lapack-netlib/BLAS/SRC/dasum.f

@@ -0,0 +1,111 @@
+*> \brief \b DASUM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    DASUM takes the sum of the absolute values.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ..
+      DOUBLE PRECISION DX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DTEMP
+      INTEGER I,M,MP1,NINCX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC DABS,MOD
+*     ..
+      DASUM = 0.0d0
+      DTEMP = 0.0d0
+      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (INCX.EQ.1) THEN
+*        code for increment equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,6)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               DTEMP = DTEMP + DABS(DX(I))
+            END DO
+            IF (N.LT.6) THEN
+               DASUM = DTEMP
+               RETURN
+            END IF
+         END IF
+         MP1 = M + 1
+         DO I = MP1,N,6
+            DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) +
+     $              DABS(DX(I+2)) + DABS(DX(I+3)) +
+     $              DABS(DX(I+4)) + DABS(DX(I+5))
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         NINCX = N*INCX
+         DO I = 1,NINCX,INCX
+            DTEMP = DTEMP + DABS(DX(I))
+         END DO
+      END IF
+      DASUM = DTEMP
+      RETURN
+      END

lapack-netlib/BLAS/SRC/daxpy.f

@@ -0,0 +1,115 @@
+*> \brief \b DAXPY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION DA
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DX(*),DY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    DAXPY constant times a vector plus a vector.
+*>    uses unrolled loops for increments equal to one.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 DA
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DX(*),DY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,IX,IY,M,MP1
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      IF (N.LE.0) RETURN
+      IF (DA.EQ.0.0d0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,4)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               DY(I) = DY(I) + DA*DX(I)
+            END DO
+         END IF
+         IF (N.LT.4) RETURN
+         MP1 = M + 1
+         DO I = MP1,N,4
+            DY(I) = DY(I) + DA*DX(I)
+            DY(I+1) = DY(I+1) + DA*DX(I+1)
+            DY(I+2) = DY(I+2) + DA*DX(I+2)
+            DY(I+3) = DY(I+3) + DA*DX(I+3)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+          DY(IY) = DY(IY) + DA*DX(IX)
+          IX = IX + INCX
+          IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/dcabs1.f

@@ -0,0 +1,58 @@
+*> \brief \b DCABS1
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       DOUBLE PRECISION FUNCTION DCABS1(Z)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX*16 Z
+*       ..
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DCABS1 computes |Re(.)| + |Im(.)| of a double complex number 
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup double_blas_level1
+*
+*  =====================================================================
+      DOUBLE PRECISION FUNCTION DCABS1(Z)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      COMPLEX*16 Z
+*     ..
+*     ..
+*  =====================================================================
+*
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,DBLE,DIMAG
+*
+      DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z))
+      RETURN
+      END

lapack-netlib/BLAS/SRC/dcopy.f

@@ -0,0 +1,115 @@
+*> \brief \b DCOPY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DX(*),DY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    DCOPY copies a vector, x, to a vector, y.
+*>    uses unrolled loops for increments equal to one.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DX(*),DY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,IX,IY,M,MP1
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,7)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               DY(I) = DX(I)
+            END DO
+            IF (N.LT.7) RETURN
+         END IF   
+         MP1 = M + 1
+         DO I = MP1,N,7
+            DY(I) = DX(I)
+            DY(I+1) = DX(I+1)
+            DY(I+2) = DX(I+2)
+            DY(I+3) = DX(I+3)
+            DY(I+4) = DX(I+4)
+            DY(I+5) = DX(I+5)
+            DY(I+6) = DX(I+6)
+         END DO
+      ELSE      
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            DY(IY) = DX(IX)
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/ddot.f

@@ -0,0 +1,117 @@
+*> \brief \b DDOT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DX(*),DY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    DDOT forms the dot product of two vectors.
+*>    uses unrolled loops for increments equal to one.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DX(*),DY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DTEMP
+      INTEGER I,IX,IY,M,MP1
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      DDOT = 0.0d0
+      DTEMP = 0.0d0
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,5)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               DTEMP = DTEMP + DX(I)*DY(I)
+            END DO
+            IF (N.LT.5) THEN
+               DDOT=DTEMP
+            RETURN
+            END IF
+         END IF
+         MP1 = M + 1
+         DO I = MP1,N,5
+          DTEMP = DTEMP + DX(I)*DY(I) + DX(I+1)*DY(I+1) +
+     $            DX(I+2)*DY(I+2) + DX(I+3)*DY(I+3) + DX(I+4)*DY(I+4)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            DTEMP = DTEMP + DX(IX)*DY(IY)
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      DDOT = DTEMP
+      RETURN
+      END

lapack-netlib/BLAS/SRC/dgbmv.f

@@ -0,0 +1,370 @@
+*> \brief \b DGBMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA,BETA
+*       INTEGER INCX,INCY,KL,KU,LDA,M,N
+*       CHARACTER TRANS
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGBMV  performs one of the matrix-vector operations
+*>
+*>    y := alpha*A*x + beta*y,   or   y := alpha*A**T*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are vectors and A is an
+*> m by n band matrix, with kl sub-diagonals and ku super-diagonals.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*>
+*>              TRANS = 'T' or 't'   y := alpha*A**T*x + beta*y.
+*>
+*>              TRANS = 'C' or 'c'   y := alpha*A**T*x + beta*y.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] KL
+*> \verbatim
+*>          KL is INTEGER
+*>           On entry, KL specifies the number of sub-diagonals of the
+*>           matrix A. KL must satisfy  0 .le. KL.
+*> \endverbatim
+*>
+*> \param[in] KU
+*> \verbatim
+*>          KU is INTEGER
+*>           On entry, KU specifies the number of super-diagonals of the
+*>           matrix A. KU must satisfy  0 .le. KU.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading ( kl + ku + 1 ) by n part of the
+*>           array A must contain the matrix of coefficients, supplied
+*>           column by column, with the leading diagonal of the matrix in
+*>           row ( ku + 1 ) of the array, the first super-diagonal
+*>           starting at position 2 in row ku, the first sub-diagonal
+*>           starting at position 1 in row ( ku + 2 ), and so on.
+*>           Elements in the array A that do not correspond to elements
+*>           in the band matrix (such as the top left ku by ku triangle)
+*>           are not referenced.
+*>           The following program segment will transfer a band matrix
+*>           from conventional full matrix storage to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    K = KU + 1 - J
+*>                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
+*>                       A( K + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( kl + ku + 1 ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*>           Before entry, the incremented array X must contain the
+*>           vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is DOUBLE PRECISION.
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is DOUBLE PRECISION array of DIMENSION at least
+*>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*>           Before entry, the incremented array Y must contain the
+*>           vector y. On exit, Y is overwritten by the updated vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION ALPHA,BETA
+      INTEGER INCX,INCY,KL,KU,LDA,M,N
+      CHARACTER TRANS
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX,MIN
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +    .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 1
+      ELSE IF (M.LT.0) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (KL.LT.0) THEN
+          INFO = 4
+      ELSE IF (KU.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT. (KL+KU+1)) THEN
+          INFO = 8
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 10
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 13
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DGBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          LENX = N
+          LENY = M
+      ELSE
+          LENX = M
+          LENY = N
+      END IF
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (LENX-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (LENY-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the band part of A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,LENY
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,LENY
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,LENY
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,LENY
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      KUP1 = KU + 1
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+          JX = KX
+          IF (INCY.EQ.1) THEN
+              DO 60 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  K = KUP1 - J
+                  DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
+                      Y(I) = Y(I) + TEMP*A(K+I,J)
+   50             CONTINUE
+                  JX = JX + INCX
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  IY = KY
+                  K = KUP1 - J
+                  DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
+                      Y(IY) = Y(IY) + TEMP*A(K+I,J)
+                      IY = IY + INCY
+   70             CONTINUE
+                  JX = JX + INCX
+                  IF (J.GT.KU) KY = KY + INCY
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y := alpha*A**T*x + y.
+*
+          JY = KY
+          IF (INCX.EQ.1) THEN
+              DO 100 J = 1,N
+                  TEMP = ZERO
+                  K = KUP1 - J
+                  DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
+                      TEMP = TEMP + A(K+I,J)*X(I)
+   90             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+  100         CONTINUE
+          ELSE
+              DO 120 J = 1,N
+                  TEMP = ZERO
+                  IX = KX
+                  K = KUP1 - J
+                  DO 110 I = MAX(1,J-KU),MIN(M,J+KL)
+                      TEMP = TEMP + A(K+I,J)*X(IX)
+                      IX = IX + INCX
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+                  IF (J.GT.KU) KX = KX + INCX
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DGBMV .
+*
+      END

lapack-netlib/BLAS/SRC/dgemm.f

@@ -0,0 +1,384 @@
+*> \brief \b DGEMM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA,BETA
+*       INTEGER K,LDA,LDB,LDC,M,N
+*       CHARACTER TRANSA,TRANSB
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGEMM  performs one of the matrix-matrix operations
+*>
+*>    C := alpha*op( A )*op( B ) + beta*C,
+*>
+*> where  op( X ) is one of
+*>
+*>    op( X ) = X   or   op( X ) = X**T,
+*>
+*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
+*> an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANSA
+*> \verbatim
+*>          TRANSA is CHARACTER*1
+*>           On entry, TRANSA specifies the form of op( A ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSA = 'N' or 'n',  op( A ) = A.
+*>
+*>              TRANSA = 'T' or 't',  op( A ) = A**T.
+*>
+*>              TRANSA = 'C' or 'c',  op( A ) = A**T.
+*> \endverbatim
+*>
+*> \param[in] TRANSB
+*> \verbatim
+*>          TRANSB is CHARACTER*1
+*>           On entry, TRANSB specifies the form of op( B ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSB = 'N' or 'n',  op( B ) = B.
+*>
+*>              TRANSB = 'T' or 't',  op( B ) = B**T.
+*>
+*>              TRANSB = 'C' or 'c',  op( B ) = B**T.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry,  M  specifies  the number  of rows  of the  matrix
+*>           op( A )  and of the  matrix  C.  M  must  be at least  zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry,  N  specifies the number  of columns of the matrix
+*>           op( B ) and the number of columns of the matrix C. N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry,  K  specifies  the number of columns of the matrix
+*>           op( A ) and the number of rows of the matrix op( B ). K must
+*>           be at least  zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*>           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
+*>           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
+*>           part of the array  A  must contain the matrix  A,  otherwise
+*>           the leading  k by m  part of the array  A  must contain  the
+*>           matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
+*>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*>           least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+*>           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
+*>           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
+*>           part of the array  B  must contain the matrix  B,  otherwise
+*>           the leading  n by k  part of the array  B  must contain  the
+*>           matrix B.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
+*>           LDB must be at least  max( 1, k ), otherwise  LDB must be at
+*>           least  max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is DOUBLE PRECISION.
+*>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*>           supplied as zero then C need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*>           Before entry, the leading  m by n  part of the array  C must
+*>           contain the matrix  C,  except when  beta  is zero, in which
+*>           case C need not be set on entry.
+*>           On exit, the array  C  is overwritten by the  m by n  matrix
+*>           ( alpha*op( A )*op( B ) + beta*C ).
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup double_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION ALPHA,BETA
+      INTEGER K,LDA,LDB,LDC,M,N
+      CHARACTER TRANSA,TRANSB
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
+      LOGICAL NOTA,NOTB
+*     ..
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*
+*     Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
+*     transposed and set  NROWA, NCOLA and  NROWB  as the number of rows
+*     and  columns of  A  and the  number of  rows  of  B  respectively.
+*
+      NOTA = LSAME(TRANSA,'N')
+      NOTB = LSAME(TRANSB,'N')
+      IF (NOTA) THEN
+          NROWA = M
+          NCOLA = K
+      ELSE
+          NROWA = K
+          NCOLA = M
+      END IF
+      IF (NOTB) THEN
+          NROWB = K
+      ELSE
+          NROWB = N
+      END IF
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND.
+     +    (.NOT.LSAME(TRANSA,'T'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND.
+     +         (.NOT.LSAME(TRANSB,'T'))) THEN
+          INFO = 2
+      ELSE IF (M.LT.0) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (K.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 8
+      ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
+          INFO = 10
+      ELSE IF (LDC.LT.MAX(1,M)) THEN
+          INFO = 13
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DGEMM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And if  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (BETA.EQ.ZERO) THEN
+              DO 20 J = 1,N
+                  DO 10 I = 1,M
+                      C(I,J) = ZERO
+   10             CONTINUE
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  DO 30 I = 1,M
+                      C(I,J) = BETA*C(I,J)
+   30             CONTINUE
+   40         CONTINUE
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (NOTB) THEN
+          IF (NOTA) THEN
+*
+*           Form  C := alpha*A*B + beta*C.
+*
+              DO 90 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 50 I = 1,M
+                          C(I,J) = ZERO
+   50                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 60 I = 1,M
+                          C(I,J) = BETA*C(I,J)
+   60                 CONTINUE
+                  END IF
+                  DO 80 L = 1,K
+                      TEMP = ALPHA*B(L,J)
+                      DO 70 I = 1,M
+                          C(I,J) = C(I,J) + TEMP*A(I,L)
+   70                 CONTINUE
+   80             CONTINUE
+   90         CONTINUE
+          ELSE
+*
+*           Form  C := alpha*A**T*B + beta*C
+*
+              DO 120 J = 1,N
+                  DO 110 I = 1,M
+                      TEMP = ZERO
+                      DO 100 L = 1,K
+                          TEMP = TEMP + A(L,I)*B(L,J)
+  100                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  110             CONTINUE
+  120         CONTINUE
+          END IF
+      ELSE
+          IF (NOTA) THEN
+*
+*           Form  C := alpha*A*B**T + beta*C
+*
+              DO 170 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 130 I = 1,M
+                          C(I,J) = ZERO
+  130                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 140 I = 1,M
+                          C(I,J) = BETA*C(I,J)
+  140                 CONTINUE
+                  END IF
+                  DO 160 L = 1,K
+                      TEMP = ALPHA*B(J,L)
+                      DO 150 I = 1,M
+                          C(I,J) = C(I,J) + TEMP*A(I,L)
+  150                 CONTINUE
+  160             CONTINUE
+  170         CONTINUE
+          ELSE
+*
+*           Form  C := alpha*A**T*B**T + beta*C
+*
+              DO 200 J = 1,N
+                  DO 190 I = 1,M
+                      TEMP = ZERO
+                      DO 180 L = 1,K
+                          TEMP = TEMP + A(L,I)*B(J,L)
+  180                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  190             CONTINUE
+  200         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DGEMM .
+*
+      END

lapack-netlib/BLAS/SRC/dgemv.f

@@ -0,0 +1,330 @@
+*> \brief \b DGEMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA,BETA
+*       INTEGER INCX,INCY,LDA,M,N
+*       CHARACTER TRANS
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGEMV  performs one of the matrix-vector operations
+*>
+*>    y := alpha*A*x + beta*y,   or   y := alpha*A**T*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are vectors and A is an
+*> m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*>
+*>              TRANS = 'T' or 't'   y := alpha*A**T*x + beta*y.
+*>
+*>              TRANS = 'C' or 'c'   y := alpha*A**T*x + beta*y.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading m by n part of the array A must
+*>           contain the matrix of coefficients.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, m ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*>           Before entry, the incremented array X must contain the
+*>           vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is DOUBLE PRECISION.
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is DOUBLE PRECISION array of DIMENSION at least
+*>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*>           Before entry with BETA non-zero, the incremented array Y
+*>           must contain the vector y. On exit, Y is overwritten by the
+*>           updated vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      DOUBLE PRECISION ALPHA,BETA
+      INTEGER INCX,INCY,LDA,M,N
+      CHARACTER TRANS
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +    .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 1
+      ELSE IF (M.LT.0) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (LDA.LT.MAX(1,M)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DGEMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          LENX = N
+          LENY = M
+      ELSE
+          LENX = M
+          LENY = N
+      END IF
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (LENX-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (LENY-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,LENY
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,LENY
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,LENY
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,LENY
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+          JX = KX
+          IF (INCY.EQ.1) THEN
+              DO 60 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  DO 50 I = 1,M
+                      Y(I) = Y(I) + TEMP*A(I,J)
+   50             CONTINUE
+                  JX = JX + INCX
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  IY = KY
+                  DO 70 I = 1,M
+                      Y(IY) = Y(IY) + TEMP*A(I,J)
+                      IY = IY + INCY
+   70             CONTINUE
+                  JX = JX + INCX
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y := alpha*A**T*x + y.
+*
+          JY = KY
+          IF (INCX.EQ.1) THEN
+              DO 100 J = 1,N
+                  TEMP = ZERO
+                  DO 90 I = 1,M
+                      TEMP = TEMP + A(I,J)*X(I)
+   90             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+  100         CONTINUE
+          ELSE
+              DO 120 J = 1,N
+                  TEMP = ZERO
+                  IX = KX
+                  DO 110 I = 1,M
+                      TEMP = TEMP + A(I,J)*X(IX)
+                      IX = IX + INCX
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DGEMV .
+*
+      END

lapack-netlib/BLAS/SRC/dger.f

@@ -0,0 +1,227 @@
+*> \brief \b DGER
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA
+*       INTEGER INCX,INCY,LDA,M,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGER   performs the rank 1 operation
+*>
+*>    A := alpha*x*y**T + A,
+*>
+*> where alpha is a scalar, x is an m element vector, y is an n element
+*> vector and A is an m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the m
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*>          Y is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading m by n part of the array A must
+*>           contain the matrix of coefficients. On exit, A is
+*>           overwritten by the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,INCY,LDA,M,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,J,JY,KX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (M.LT.0) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 7
+      ELSE IF (LDA.LT.MAX(1,M)) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DGER  ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (INCY.GT.0) THEN
+          JY = 1
+      ELSE
+          JY = 1 - (N-1)*INCY
+      END IF
+      IF (INCX.EQ.1) THEN
+          DO 20 J = 1,N
+              IF (Y(JY).NE.ZERO) THEN
+                  TEMP = ALPHA*Y(JY)
+                  DO 10 I = 1,M
+                      A(I,J) = A(I,J) + X(I)*TEMP
+   10             CONTINUE
+              END IF
+              JY = JY + INCY
+   20     CONTINUE
+      ELSE
+          IF (INCX.GT.0) THEN
+              KX = 1
+          ELSE
+              KX = 1 - (M-1)*INCX
+          END IF
+          DO 40 J = 1,N
+              IF (Y(JY).NE.ZERO) THEN
+                  TEMP = ALPHA*Y(JY)
+                  IX = KX
+                  DO 30 I = 1,M
+                      A(I,J) = A(I,J) + X(IX)*TEMP
+                      IX = IX + INCX
+   30             CONTINUE
+              END IF
+              JY = JY + INCY
+   40     CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of DGER  .
+*
+      END

lapack-netlib/BLAS/SRC/dnrm2.f

@@ -0,0 +1,112 @@
+*> \brief \b DNRM2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DNRM2 returns the euclidean norm of a vector via the function
+*> name, so that
+*>
+*>    DNRM2 := sqrt( x'*x )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  -- This version written on 25-October-1982.
+*>     Modified on 14-October-1993 to inline the call to DLASSQ.
+*>     Sven Hammarling, Nag Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ..
+      DOUBLE PRECISION X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ
+      INTEGER IX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,SQRT
+*     ..
+      IF (N.LT.1 .OR. INCX.LT.1) THEN
+          NORM = ZERO
+      ELSE IF (N.EQ.1) THEN
+          NORM = ABS(X(1))
+      ELSE
+          SCALE = ZERO
+          SSQ = ONE
+*        The following loop is equivalent to this call to the LAPACK
+*        auxiliary routine:
+*        CALL DLASSQ( N, X, INCX, SCALE, SSQ )
+*
+          DO 10 IX = 1,1 + (N-1)*INCX,INCX
+              IF (X(IX).NE.ZERO) THEN
+                  ABSXI = ABS(X(IX))
+                  IF (SCALE.LT.ABSXI) THEN
+                      SSQ = ONE + SSQ* (SCALE/ABSXI)**2
+                      SCALE = ABSXI
+                  ELSE
+                      SSQ = SSQ + (ABSXI/SCALE)**2
+                  END IF
+              END IF
+   10     CONTINUE
+          NORM = SCALE*SQRT(SSQ)
+      END IF
+*
+      DNRM2 = NORM
+      RETURN
+*
+*     End of DNRM2.
+*
+      END

lapack-netlib/BLAS/SRC/drot.f

@@ -0,0 +1,101 @@
+*> \brief \b DROT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION C,S
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DX(*),DY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    DROT applies a plane rotation.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 C,S
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DX(*),DY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DTEMP
+      INTEGER I,IX,IY
+*     ..
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*       code for both increments equal to 1
+*
+         DO I = 1,N
+            DTEMP = C*DX(I) + S*DY(I)
+            DY(I) = C*DY(I) - S*DX(I)
+            DX(I) = DTEMP
+         END DO
+      ELSE
+*
+*       code for unequal increments or equal increments not equal
+*         to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            DTEMP = C*DX(IX) + S*DY(IY)
+            DY(IY) = C*DY(IY) - S*DX(IX)
+            DX(IX) = DTEMP
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/drotg.f

@@ -0,0 +1,86 @@
+*> \brief \b DROTG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DROTG(DA,DB,C,S)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION C,DA,DB,S
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    DROTG construct givens plane rotation.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DROTG(DA,DB,C,S)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 C,DA,DB,S
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION R,ROE,SCALE,Z
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC DABS,DSIGN,DSQRT
+*     ..
+      ROE = DB
+      IF (DABS(DA).GT.DABS(DB)) ROE = DA
+      SCALE = DABS(DA) + DABS(DB)
+      IF (SCALE.EQ.0.0d0) THEN
+         C = 1.0d0
+         S = 0.0d0
+         R = 0.0d0
+         Z = 0.0d0
+      ELSE
+         R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2)
+         R = DSIGN(1.0d0,ROE)*R
+         C = DA/R
+         S = DB/R
+         Z = 1.0d0
+         IF (DABS(DA).GT.DABS(DB)) Z = S
+         IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C
+      END IF
+      DA = R
+      DB = Z
+      RETURN
+      END

lapack-netlib/BLAS/SRC/drotm.f

@@ -0,0 +1,202 @@
+*> \brief \b DROTM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
+*>
+*>    (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
+*>    (DY**T)
+*>
+*>    DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
+*>    LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
+*>    WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+*>
+*>    DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0
+*>
+*>      (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)
+*>    H=(          )    (          )    (          )    (          )
+*>      (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).
+*>    SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>         number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] DX
+*> \verbatim
+*>          DX is DOUBLE PRECISION array, dimension N
+*>         double precision vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>         storage spacing between elements of DX
+*> \endverbatim
+*>
+*> \param[in,out] DY
+*> \verbatim
+*>          DY is DOUBLE PRECISION array, dimension N
+*>         double precision vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>         storage spacing between elements of DY
+*> \endverbatim
+*>
+*> \param[in,out] DPARAM
+*> \verbatim
+*>          DPARAM is DOUBLE PRECISION array, dimension 5
+*>     DPARAM(1)=DFLAG
+*>     DPARAM(2)=DH11
+*>     DPARAM(3)=DH21
+*>     DPARAM(4)=DH12
+*>     DPARAM(5)=DH22
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*  =====================================================================
+      SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
+      INTEGER I,KX,KY,NSTEPS
+*     ..
+*     .. Data statements ..
+      DATA ZERO,TWO/0.D0,2.D0/
+*     ..
+*
+      DFLAG = DPARAM(1)
+      IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN
+      IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
+*
+         NSTEPS = N*INCX
+         IF (DFLAG.LT.ZERO) THEN
+            DH11 = DPARAM(2)
+            DH12 = DPARAM(4)
+            DH21 = DPARAM(3)
+            DH22 = DPARAM(5)
+            DO I = 1,NSTEPS,INCX
+               W = DX(I)
+               Z = DY(I)
+               DX(I) = W*DH11 + Z*DH12
+               DY(I) = W*DH21 + Z*DH22
+            END DO
+         ELSE IF (DFLAG.EQ.ZERO) THEN
+            DH12 = DPARAM(4)
+            DH21 = DPARAM(3)
+            DO I = 1,NSTEPS,INCX
+               W = DX(I)
+               Z = DY(I)
+               DX(I) = W + Z*DH12
+               DY(I) = W*DH21 + Z
+            END DO
+         ELSE
+            DH11 = DPARAM(2)
+            DH22 = DPARAM(5)
+            DO I = 1,NSTEPS,INCX
+               W = DX(I)
+               Z = DY(I)
+               DX(I) = W*DH11 + Z
+               DY(I) = -W + DH22*Z
+            END DO
+         END IF
+      ELSE
+         KX = 1
+         KY = 1
+         IF (INCX.LT.0) KX = 1 + (1-N)*INCX
+         IF (INCY.LT.0) KY = 1 + (1-N)*INCY
+*
+         IF (DFLAG.LT.ZERO) THEN
+            DH11 = DPARAM(2)
+            DH12 = DPARAM(4)
+            DH21 = DPARAM(3)
+            DH22 = DPARAM(5)
+            DO I = 1,N
+               W = DX(KX)
+               Z = DY(KY)
+               DX(KX) = W*DH11 + Z*DH12
+               DY(KY) = W*DH21 + Z*DH22
+               KX = KX + INCX
+               KY = KY + INCY
+            END DO
+         ELSE IF (DFLAG.EQ.ZERO) THEN
+            DH12 = DPARAM(4)
+            DH21 = DPARAM(3)
+            DO I = 1,N
+               W = DX(KX)
+               Z = DY(KY)
+               DX(KX) = W + Z*DH12
+               DY(KY) = W*DH21 + Z
+               KX = KX + INCX
+               KY = KY + INCY
+            END DO
+         ELSE
+             DH11 = DPARAM(2)
+             DH22 = DPARAM(5)
+             DO I = 1,N
+                W = DX(KX)
+                Z = DY(KY)
+                DX(KX) = W*DH11 + Z
+                DY(KY) = -W + DH22*Z
+                KX = KX + INCX
+                KY = KY + INCY
+            END DO
+         END IF
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/drotmg.f

@@ -0,0 +1,251 @@
+*> \brief \b DROTMG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION DD1,DD2,DX1,DY1
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DPARAM(5)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
+*>    THE SECOND COMPONENT OF THE 2-VECTOR  (DSQRT(DD1)*DX1,DSQRT(DD2)*>    DY2)**T.
+*>    WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+*>
+*>    DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0
+*>
+*>      (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)
+*>    H=(          )    (          )    (          )    (          )
+*>      (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).
+*>    LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22
+*>    RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE
+*>    VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)
+*>
+*>    THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
+*>    INEXACT.  THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
+*>    OF DD1 AND DD2.  ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
+*>
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in,out] DD1
+*> \verbatim
+*>          DD1 is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in,out] DD2
+*> \verbatim
+*>          DD2 is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in,out] DX1
+*> \verbatim
+*>          DX1 is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in] DY1
+*> \verbatim
+*>          DY1 is DOUBLE PRECISION
+*> \endverbatim
+*>
+*> \param[in,out] DPARAM
+*> \verbatim
+*>          DPARAM is DOUBLE PRECISION array, dimension 5
+*>     DPARAM(1)=DFLAG
+*>     DPARAM(2)=DH11
+*>     DPARAM(3)=DH21
+*>     DPARAM(4)=DH12
+*>     DPARAM(5)=DH22
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*  =====================================================================
+      SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 DD1,DD2,DX1,DY1
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DPARAM(5)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,DP1,DP2,DQ1,DQ2,DTEMP,
+     $                 DU,GAM,GAMSQ,ONE,RGAMSQ,TWO,ZERO
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC DABS
+*     ..
+*     .. Data statements ..
+*
+      DATA ZERO,ONE,TWO/0.D0,1.D0,2.D0/
+      DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/
+*     ..
+
+      IF (DD1.LT.ZERO) THEN
+*        GO ZERO-H-D-AND-DX1..
+         DFLAG = -ONE
+         DH11 = ZERO
+         DH12 = ZERO
+         DH21 = ZERO
+         DH22 = ZERO
+*
+         DD1 = ZERO
+         DD2 = ZERO
+         DX1 = ZERO
+      ELSE
+*        CASE-DD1-NONNEGATIVE
+         DP2 = DD2*DY1
+         IF (DP2.EQ.ZERO) THEN
+            DFLAG = -TWO
+            DPARAM(1) = DFLAG
+            RETURN
+         END IF 
+*        REGULAR-CASE..
+         DP1 = DD1*DX1
+         DQ2 = DP2*DY1
+         DQ1 = DP1*DX1
+*
+         IF (DABS(DQ1).GT.DABS(DQ2)) THEN
+            DH21 = -DY1/DX1
+            DH12 = DP2/DP1
+*
+            DU = ONE - DH12*DH21
+*
+           IF (DU.GT.ZERO) THEN
+             DFLAG = ZERO
+             DD1 = DD1/DU
+             DD2 = DD2/DU
+             DX1 = DX1*DU
+           END IF
+         ELSE
+
+            IF (DQ2.LT.ZERO) THEN
+*              GO ZERO-H-D-AND-DX1..
+               DFLAG = -ONE
+               DH11 = ZERO
+               DH12 = ZERO
+               DH21 = ZERO
+               DH22 = ZERO
+*
+               DD1 = ZERO
+               DD2 = ZERO
+               DX1 = ZERO
+            ELSE
+               DFLAG = ONE
+               DH11 = DP1/DP2
+               DH22 = DX1/DY1
+               DU = ONE + DH11*DH22
+               DTEMP = DD2/DU
+               DD2 = DD1/DU
+               DD1 = DTEMP
+               DX1 = DY1*DU
+            END IF
+         END IF
+
+*     PROCEDURE..SCALE-CHECK
+         IF (DD1.NE.ZERO) THEN
+            DO WHILE ((DD1.LE.RGAMSQ) .OR. (DD1.GE.GAMSQ))
+               IF (DFLAG.EQ.ZERO) THEN
+                  DH11 = ONE
+                  DH22 = ONE
+                  DFLAG = -ONE
+               ELSE
+                  DH21 = -ONE
+                  DH12 = ONE
+                  DFLAG = -ONE
+               END IF
+               IF (DD1.LE.RGAMSQ) THEN
+                  DD1 = DD1*GAM**2
+                  DX1 = DX1/GAM
+                  DH11 = DH11/GAM
+                  DH12 = DH12/GAM
+               ELSE
+                  DD1 = DD1/GAM**2
+                  DX1 = DX1*GAM
+                  DH11 = DH11*GAM
+                  DH12 = DH12*GAM
+               END IF
+            ENDDO
+         END IF
+  
+         IF (DD2.NE.ZERO) THEN
+            DO WHILE ( (DABS(DD2).LE.RGAMSQ) .OR. (DABS(DD2).GE.GAMSQ) )
+               IF (DFLAG.EQ.ZERO) THEN
+                  DH11 = ONE
+                  DH22 = ONE
+                  DFLAG = -ONE
+               ELSE
+                  DH21 = -ONE
+                  DH12 = ONE
+                  DFLAG = -ONE
+               END IF
+               IF (DABS(DD2).LE.RGAMSQ) THEN
+                  DD2 = DD2*GAM**2
+                  DH21 = DH21/GAM
+                  DH22 = DH22/GAM
+               ELSE
+                  DD2 = DD2/GAM**2
+                  DH21 = DH21*GAM
+                  DH22 = DH22*GAM
+               END IF      
+            END DO
+         END IF
+     
+      END IF
+
+      IF (DFLAG.LT.ZERO) THEN
+         DPARAM(2) = DH11
+         DPARAM(3) = DH21
+         DPARAM(4) = DH12
+         DPARAM(5) = DH22
+      ELSE IF (DFLAG.EQ.ZERO) THEN
+         DPARAM(3) = DH21
+         DPARAM(4) = DH12 
+      ELSE
+         DPARAM(2) = DH11
+         DPARAM(5) = DH22
+      END IF
+
+      DPARAM(1) = DFLAG
+      RETURN
+      END
+      
+     
+     
+     

lapack-netlib/BLAS/SRC/dsbmv.f

@@ -0,0 +1,375 @@
+*> \brief \b DSBMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA,BETA
+*       INTEGER INCX,INCY,K,LDA,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSBMV  performs the matrix-vector  operation
+*>
+*>    y := alpha*A*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are n element vectors and
+*> A is an n by n symmetric band matrix, with k super-diagonals.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the band matrix A is being supplied as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  being supplied.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  being supplied.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry, K specifies the number of super-diagonals of the
+*>           matrix A. K must satisfy  0 .le. K.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*>           by n part of the array A must contain the upper triangular
+*>           band part of the symmetric matrix, supplied column by
+*>           column, with the leading diagonal of the matrix in row
+*>           ( k + 1 ) of the array, the first super-diagonal starting at
+*>           position 2 in row k, and so on. The top left k by k triangle
+*>           of the array A is not referenced.
+*>           The following program segment will transfer the upper
+*>           triangular part of a symmetric band matrix from conventional
+*>           full matrix storage to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = K + 1 - J
+*>                    DO 10, I = MAX( 1, J - K ), J
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*>           by n part of the array A must contain the lower triangular
+*>           band part of the symmetric matrix, supplied column by
+*>           column, with the leading diagonal of the matrix in row 1 of
+*>           the array, the first sub-diagonal starting at position 1 in
+*>           row 2, and so on. The bottom right k by k triangle of the
+*>           array A is not referenced.
+*>           The following program segment will transfer the lower
+*>           triangular part of a symmetric band matrix from conventional
+*>           full matrix storage to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = 1 - J
+*>                    DO 10, I = J, MIN( N, J + K )
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( k + 1 ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the
+*>           vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is DOUBLE PRECISION.
+*>           On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is DOUBLE PRECISION array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the
+*>           vector y. On exit, Y is overwritten by the updated vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER INCX,INCY,K,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,KPLUS1,KX,KY,L
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX,MIN
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (K.LT.0) THEN
+          INFO = 3
+      ELSE IF (LDA.LT. (K+1)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (N-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (N-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array A
+*     are accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,N
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,N
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,N
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,N
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  y  when upper triangle of A is stored.
+*
+          KPLUS1 = K + 1
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  L = KPLUS1 - J
+                  DO 50 I = MAX(1,J-K),J - 1
+                      Y(I) = Y(I) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + A(L+I,J)*X(I)
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*A(KPLUS1,J) + ALPHA*TEMP2
+   60         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 80 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  IX = KX
+                  IY = KY
+                  L = KPLUS1 - J
+                  DO 70 I = MAX(1,J-K),J - 1
+                      Y(IY) = Y(IY) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + A(L+I,J)*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*A(KPLUS1,J) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  IF (J.GT.K) THEN
+                      KX = KX + INCX
+                      KY = KY + INCY
+                  END IF
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y  when lower triangle of A is stored.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 100 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  Y(J) = Y(J) + TEMP1*A(1,J)
+                  L = 1 - J
+                  DO 90 I = J + 1,MIN(N,J+K)
+                      Y(I) = Y(I) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + A(L+I,J)*X(I)
+   90             CONTINUE
+                  Y(J) = Y(J) + ALPHA*TEMP2
+  100         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 120 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  Y(JY) = Y(JY) + TEMP1*A(1,J)
+                  L = 1 - J
+                  IX = JX
+                  IY = JY
+                  DO 110 I = J + 1,MIN(N,J+K)
+                      IX = IX + INCX
+                      IY = IY + INCY
+                      Y(IY) = Y(IY) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + A(L+I,J)*X(IX)
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSBMV .
+*
+      END

lapack-netlib/BLAS/SRC/dscal.f

@@ -0,0 +1,110 @@
+*> \brief \b DSCAL
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSCAL(N,DA,DX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION DA
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    DSCAL scales a vector by a constant.
+*>    uses unrolled loops for increment equal to one.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSCAL(N,DA,DX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 DA
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,M,MP1,NINCX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,5)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               DX(I) = DA*DX(I)
+            END DO
+            IF (N.LT.5) RETURN
+         END IF
+         MP1 = M + 1
+         DO I = MP1,N,5
+            DX(I) = DA*DX(I)
+            DX(I+1) = DA*DX(I+1)
+            DX(I+2) = DA*DX(I+2)
+            DX(I+3) = DA*DX(I+3)
+            DX(I+4) = DA*DX(I+4)
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         NINCX = N*INCX
+         DO I = 1,NINCX,INCX
+            DX(I) = DA*DX(I)
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/dsdot.f

@@ -0,0 +1,172 @@
+*> \brief \b DSDOT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       DOUBLE PRECISION FUNCTION DSDOT(N,SX,INCX,SY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SX(*),SY(*)
+*       ..
+*  
+*    AUTHORS
+*    =======
+*    Lawson, C. L., (JPL), Hanson, R. J., (SNLA), 
+*    Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> Compute the inner product of two vectors with extended
+*> precision accumulation and result.
+*>
+*> Returns D.P. dot product accumulated in D.P., for S.P. SX and SY
+*> DSDOT = sum for I = 0 to N-1 of  SX(LX+I*INCX) * SY(LY+I*INCY),
+*> where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+*> defined in a similar way using INCY.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>         number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in] SX
+*> \verbatim
+*>          SX is REAL array, dimension(N)
+*>         single precision vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>          storage spacing between elements of SX
+*> \endverbatim
+*>
+*> \param[in] SY
+*> \verbatim
+*>          SY is REAL array, dimension(N)
+*>         single precision vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>         storage spacing between elements of SY
+*> \endverbatim
+*>
+*> \result DSDOT
+*> \verbatim
+*>          DSDOT is DOUBLE PRECISION
+*>         DSDOT  double precision dot product (zero if N.LE.0)
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> \endverbatim
+*
+*> \par References:
+*  ================
+*>
+*> \verbatim
+*>
+*>      
+*>  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+*>  Krogh, Basic linear algebra subprograms for Fortran
+*>  usage, Algorithm No. 539, Transactions on Mathematical
+*>  Software 5, 3 (September 1979), pp. 308-323.
+*>
+*>  REVISION HISTORY  (YYMMDD)
+*>
+*>  791001  DATE WRITTEN
+*>  890831  Modified array declarations.  (WRB)
+*>  890831  REVISION DATE from Version 3.2
+*>  891214  Prologue converted to Version 4.0 format.  (BAB)
+*>  920310  Corrected definition of LX in DESCRIPTION.  (WRB)
+*>  920501  Reformatted the REFERENCES section.  (WRB)
+*>  070118  Reformat to LAPACK style (JL)
+*> \endverbatim
+*>
+*  =====================================================================
+      DOUBLE PRECISION FUNCTION DSDOT(N,SX,INCX,SY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*),SY(*)
+*     ..
+*
+*  Authors:
+*  ========
+*  Lawson, C. L., (JPL), Hanson, R. J., (SNLA), 
+*  Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,KX,KY,NS
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC DBLE
+*     ..
+      DSDOT = 0.0D0
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN
+*
+*     Code for equal, positive, non-unit increments.
+*
+         NS = N*INCX
+         DO I = 1,NS,INCX
+            DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
+         END DO
+      ELSE
+*
+*     Code for unequal or nonpositive increments.
+*
+         KX = 1
+         KY = 1
+         IF (INCX.LT.0) KX = 1 + (1-N)*INCX
+         IF (INCY.LT.0) KY = 1 + (1-N)*INCY
+         DO I = 1,N
+            DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
+            KX = KX + INCX
+            KY = KY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/dspmv.f

@@ -0,0 +1,331 @@
+*> \brief \b DSPMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA,BETA
+*       INTEGER INCX,INCY,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION AP(*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSPMV  performs the matrix-vector operation
+*>
+*>    y := alpha*A*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are n element vectors and
+*> A is an n by n symmetric matrix, supplied in packed form.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the matrix A is supplied in the packed
+*>           array AP as follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  supplied in AP.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  supplied in AP.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] AP
+*> \verbatim
+*>          AP is DOUBLE PRECISION array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular part of the symmetric matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*>           and a( 2, 2 ) respectively, and so on.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular part of the symmetric matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*>           and a( 3, 1 ) respectively, and so on.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is DOUBLE PRECISION.
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y. On exit, Y is overwritten by the updated
+*>           vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER INCX,INCY,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION AP(*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 6
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSPMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (N-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (N-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,N
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,N
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,N
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,N
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      KK = 1
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  y  when AP contains the upper triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  K = KK
+                  DO 50 I = 1,J - 1
+                      Y(I) = Y(I) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + AP(K)*X(I)
+                      K = K + 1
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
+                  KK = KK + J
+   60         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 80 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  IX = KX
+                  IY = KY
+                  DO 70 K = KK,KK + J - 2
+                      Y(IY) = Y(IY) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + AP(K)*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  KK = KK + J
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y  when AP contains the lower triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 100 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  Y(J) = Y(J) + TEMP1*AP(KK)
+                  K = KK + 1
+                  DO 90 I = J + 1,N
+                      Y(I) = Y(I) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + AP(K)*X(I)
+                      K = K + 1
+   90             CONTINUE
+                  Y(J) = Y(J) + ALPHA*TEMP2
+                  KK = KK + (N-J+1)
+  100         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 120 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  Y(JY) = Y(JY) + TEMP1*AP(KK)
+                  IX = JX
+                  IY = JY
+                  DO 110 K = KK + 1,KK + N - J
+                      IX = IX + INCX
+                      IY = IY + INCY
+                      Y(IY) = Y(IY) + TEMP1*AP(K)
+                      TEMP2 = TEMP2 + AP(K)*X(IX)
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  KK = KK + (N-J+1)
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSPMV .
+*
+      END

lapack-netlib/BLAS/SRC/dspr.f

@@ -0,0 +1,261 @@
+*> \brief \b DSPR
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSPR(UPLO,N,ALPHA,X,INCX,AP)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA
+*       INTEGER INCX,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION AP(*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSPR    performs the symmetric rank 1 operation
+*>
+*>    A := alpha*x*x**T + A,
+*>
+*> where alpha is a real scalar, x is an n element vector and A is an
+*> n by n symmetric matrix, supplied in packed form.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the matrix A is supplied in the packed
+*>           array AP as follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  supplied in AP.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  supplied in AP.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] AP
+*> \verbatim
+*>          AP is DOUBLE PRECISION array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with  UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular part of the symmetric matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*>           and a( 2, 2 ) respectively, and so on. On exit, the array
+*>           AP is overwritten by the upper triangular part of the
+*>           updated matrix.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular part of the symmetric matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*>           and a( 3, 1 ) respectively, and so on. On exit, the array
+*>           AP is overwritten by the lower triangular part of the
+*>           updated matrix.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSPR(UPLO,N,ALPHA,X,INCX,AP)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION AP(*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,J,JX,K,KK,KX
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSPR  ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Set the start point in X if the increment is not unity.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+      KK = 1
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  A  when upper triangle is stored in AP.
+*
+          IF (INCX.EQ.1) THEN
+              DO 20 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*X(J)
+                      K = KK
+                      DO 10 I = 1,J
+                          AP(K) = AP(K) + X(I)*TEMP
+                          K = K + 1
+   10                 CONTINUE
+                  END IF
+                  KK = KK + J
+   20         CONTINUE
+          ELSE
+              JX = KX
+              DO 40 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*X(JX)
+                      IX = KX
+                      DO 30 K = KK,KK + J - 1
+                          AP(K) = AP(K) + X(IX)*TEMP
+                          IX = IX + INCX
+   30                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + J
+   40         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  A  when lower triangle is stored in AP.
+*
+          IF (INCX.EQ.1) THEN
+              DO 60 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*X(J)
+                      K = KK
+                      DO 50 I = J,N
+                          AP(K) = AP(K) + X(I)*TEMP
+                          K = K + 1
+   50                 CONTINUE
+                  END IF
+                  KK = KK + N - J + 1
+   60         CONTINUE
+          ELSE
+              JX = KX
+              DO 80 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*X(JX)
+                      IX = JX
+                      DO 70 K = KK,KK + N - J
+                          AP(K) = AP(K) + X(IX)*TEMP
+                          IX = IX + INCX
+   70                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + N - J + 1
+   80         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSPR  .
+*
+      END

lapack-netlib/BLAS/SRC/dspr2.f

@@ -0,0 +1,296 @@
+*> \brief \b DSPR2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA
+*       INTEGER INCX,INCY,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION AP(*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSPR2  performs the symmetric rank 2 operation
+*>
+*>    A := alpha*x*y**T + alpha*y*x**T + A,
+*>
+*> where alpha is a scalar, x and y are n element vectors and A is an
+*> n by n symmetric matrix, supplied in packed form.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the matrix A is supplied in the packed
+*>           array AP as follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  supplied in AP.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  supplied in AP.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*>          Y is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] AP
+*> \verbatim
+*>          AP is DOUBLE PRECISION array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with  UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular part of the symmetric matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
+*>           and a( 2, 2 ) respectively, and so on. On exit, the array
+*>           AP is overwritten by the upper triangular part of the
+*>           updated matrix.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular part of the symmetric matrix
+*>           packed sequentially, column by column, so that AP( 1 )
+*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
+*>           and a( 3, 1 ) respectively, and so on. On exit, the array
+*>           AP is overwritten by the lower triangular part of the
+*>           updated matrix.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,INCY,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION AP(*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 7
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSPR2 ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Set up the start points in X and Y if the increments are not both
+*     unity.
+*
+      IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
+          IF (INCX.GT.0) THEN
+              KX = 1
+          ELSE
+              KX = 1 - (N-1)*INCX
+          END IF
+          IF (INCY.GT.0) THEN
+              KY = 1
+          ELSE
+              KY = 1 - (N-1)*INCY
+          END IF
+          JX = KX
+          JY = KY
+      END IF
+*
+*     Start the operations. In this version the elements of the array AP
+*     are accessed sequentially with one pass through AP.
+*
+      KK = 1
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  A  when upper triangle is stored in AP.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 20 J = 1,N
+                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*Y(J)
+                      TEMP2 = ALPHA*X(J)
+                      K = KK
+                      DO 10 I = 1,J
+                          AP(K) = AP(K) + X(I)*TEMP1 + Y(I)*TEMP2
+                          K = K + 1
+   10                 CONTINUE
+                  END IF
+                  KK = KK + J
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*Y(JY)
+                      TEMP2 = ALPHA*X(JX)
+                      IX = KX
+                      IY = KY
+                      DO 30 K = KK,KK + J - 1
+                          AP(K) = AP(K) + X(IX)*TEMP1 + Y(IY)*TEMP2
+                          IX = IX + INCX
+                          IY = IY + INCY
+   30                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  KK = KK + J
+   40         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  A  when lower triangle is stored in AP.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*Y(J)
+                      TEMP2 = ALPHA*X(J)
+                      K = KK
+                      DO 50 I = J,N
+                          AP(K) = AP(K) + X(I)*TEMP1 + Y(I)*TEMP2
+                          K = K + 1
+   50                 CONTINUE
+                  END IF
+                  KK = KK + N - J + 1
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*Y(JY)
+                      TEMP2 = ALPHA*X(JX)
+                      IX = JX
+                      IY = JY
+                      DO 70 K = KK,KK + N - J
+                          AP(K) = AP(K) + X(IX)*TEMP1 + Y(IY)*TEMP2
+                          IX = IX + INCX
+                          IY = IY + INCY
+   70                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  KK = KK + N - J + 1
+   80         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSPR2 .
+*
+      END

lapack-netlib/BLAS/SRC/dswap.f

@@ -0,0 +1,122 @@
+*> \brief \b DSWAP
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DX(*),DY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    interchanges two vectors.
+*>    uses unrolled loops for increments equal one.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSWAP(N,DX,INCX,DY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DX(*),DY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DTEMP
+      INTEGER I,IX,IY,M,MP1
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*       code for both increments equal to 1
+*
+*
+*       clean-up loop
+*
+         M = MOD(N,3)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               DTEMP = DX(I)
+               DX(I) = DY(I)
+               DY(I) = DTEMP
+            END DO
+            IF (N.LT.3) RETURN
+         END IF
+         MP1 = M + 1
+         DO I = MP1,N,3
+            DTEMP = DX(I)
+            DX(I) = DY(I)
+            DY(I) = DTEMP
+            DTEMP = DX(I+1)
+            DX(I+1) = DY(I+1)
+            DY(I+1) = DTEMP
+            DTEMP = DX(I+2)
+            DX(I+2) = DY(I+2)
+            DY(I+2) = DTEMP
+         END DO
+      ELSE
+*
+*       code for unequal increments or equal increments not equal
+*         to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            DTEMP = DX(IX)
+            DX(IX) = DY(IY)
+            DY(IY) = DTEMP
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/dsymm.f

@@ -0,0 +1,367 @@
+*> \brief \b DSYMM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA,BETA
+*       INTEGER LDA,LDB,LDC,M,N
+*       CHARACTER SIDE,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYMM  performs one of the matrix-matrix operations
+*>
+*>    C := alpha*A*B + beta*C,
+*>
+*> or
+*>
+*>    C := alpha*B*A + beta*C,
+*>
+*> where alpha and beta are scalars,  A is a symmetric matrix and  B and
+*> C are  m by n matrices.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>           On entry,  SIDE  specifies whether  the  symmetric matrix  A
+*>           appears on the  left or right  in the  operation as follows:
+*>
+*>              SIDE = 'L' or 'l'   C := alpha*A*B + beta*C,
+*>
+*>              SIDE = 'R' or 'r'   C := alpha*B*A + beta*C,
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*>           triangular  part  of  the  symmetric  matrix   A  is  to  be
+*>           referenced as follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the upper triangular part of the
+*>                                  symmetric matrix is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the lower triangular part of the
+*>                                  symmetric matrix is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry,  M  specifies the number of rows of the matrix  C.
+*>           M  must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix C.
+*>           N  must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*>           m  when  SIDE = 'L' or 'l'  and is  n otherwise.
+*>           Before entry  with  SIDE = 'L' or 'l',  the  m by m  part of
+*>           the array  A  must contain the  symmetric matrix,  such that
+*>           when  UPLO = 'U' or 'u', the leading m by m upper triangular
+*>           part of the array  A  must contain the upper triangular part
+*>           of the  symmetric matrix and the  strictly  lower triangular
+*>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*>           the leading  m by m  lower triangular part  of the  array  A
+*>           must  contain  the  lower triangular part  of the  symmetric
+*>           matrix and the  strictly upper triangular part of  A  is not
+*>           referenced.
+*>           Before entry  with  SIDE = 'R' or 'r',  the  n by n  part of
+*>           the array  A  must contain the  symmetric matrix,  such that
+*>           when  UPLO = 'U' or 'u', the leading n by n upper triangular
+*>           part of the array  A  must contain the upper triangular part
+*>           of the  symmetric matrix and the  strictly  lower triangular
+*>           part of  A  is not referenced,  and when  UPLO = 'L' or 'l',
+*>           the leading  n by n  lower triangular part  of the  array  A
+*>           must  contain  the  lower triangular part  of the  symmetric
+*>           matrix and the  strictly upper triangular part of  A  is not
+*>           referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*>           least  max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+*>           Before entry, the leading  m by n part of the array  B  must
+*>           contain the matrix B.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is DOUBLE PRECISION.
+*>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*>           supplied as zero then C need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*>           Before entry, the leading  m by n  part of the array  C must
+*>           contain the matrix  C,  except when  beta  is zero, in which
+*>           case C need not be set on entry.
+*>           On exit, the array  C  is overwritten by the  m by n updated
+*>           matrix.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSYMM(SIDE,UPLO,M,N,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER LDA,LDB,LDC,M,N
+      CHARACTER SIDE,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP1,TEMP2
+      INTEGER I,INFO,J,K,NROWA
+      LOGICAL UPPER
+*     ..
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*
+*     Set NROWA as the number of rows of A.
+*
+      IF (LSAME(SIDE,'L')) THEN
+          NROWA = M
+      ELSE
+          NROWA = N
+      END IF
+      UPPER = LSAME(UPLO,'U')
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF ((.NOT.LSAME(SIDE,'L')) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 2
+      ELSE IF (M.LT.0) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 7
+      ELSE IF (LDB.LT.MAX(1,M)) THEN
+          INFO = 9
+      ELSE IF (LDC.LT.MAX(1,M)) THEN
+          INFO = 12
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSYMM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (BETA.EQ.ZERO) THEN
+              DO 20 J = 1,N
+                  DO 10 I = 1,M
+                      C(I,J) = ZERO
+   10             CONTINUE
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  DO 30 I = 1,M
+                      C(I,J) = BETA*C(I,J)
+   30             CONTINUE
+   40         CONTINUE
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSAME(SIDE,'L')) THEN
+*
+*        Form  C := alpha*A*B + beta*C.
+*
+          IF (UPPER) THEN
+              DO 70 J = 1,N
+                  DO 60 I = 1,M
+                      TEMP1 = ALPHA*B(I,J)
+                      TEMP2 = ZERO
+                      DO 50 K = 1,I - 1
+                          C(K,J) = C(K,J) + TEMP1*A(K,I)
+                          TEMP2 = TEMP2 + B(K,J)*A(K,I)
+   50                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
+     +                             ALPHA*TEMP2
+                      END IF
+   60             CONTINUE
+   70         CONTINUE
+          ELSE
+              DO 100 J = 1,N
+                  DO 90 I = M,1,-1
+                      TEMP1 = ALPHA*B(I,J)
+                      TEMP2 = ZERO
+                      DO 80 K = I + 1,M
+                          C(K,J) = C(K,J) + TEMP1*A(K,I)
+                          TEMP2 = TEMP2 + B(K,J)*A(K,I)
+   80                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = TEMP1*A(I,I) + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + TEMP1*A(I,I) +
+     +                             ALPHA*TEMP2
+                      END IF
+   90             CONTINUE
+  100         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  C := alpha*B*A + beta*C.
+*
+          DO 170 J = 1,N
+              TEMP1 = ALPHA*A(J,J)
+              IF (BETA.EQ.ZERO) THEN
+                  DO 110 I = 1,M
+                      C(I,J) = TEMP1*B(I,J)
+  110             CONTINUE
+              ELSE
+                  DO 120 I = 1,M
+                      C(I,J) = BETA*C(I,J) + TEMP1*B(I,J)
+  120             CONTINUE
+              END IF
+              DO 140 K = 1,J - 1
+                  IF (UPPER) THEN
+                      TEMP1 = ALPHA*A(K,J)
+                  ELSE
+                      TEMP1 = ALPHA*A(J,K)
+                  END IF
+                  DO 130 I = 1,M
+                      C(I,J) = C(I,J) + TEMP1*B(I,K)
+  130             CONTINUE
+  140         CONTINUE
+              DO 160 K = J + 1,N
+                  IF (UPPER) THEN
+                      TEMP1 = ALPHA*A(J,K)
+                  ELSE
+                      TEMP1 = ALPHA*A(K,J)
+                  END IF
+                  DO 150 I = 1,M
+                      C(I,J) = C(I,J) + TEMP1*B(I,K)
+  150             CONTINUE
+  160         CONTINUE
+  170     CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of DSYMM .
+*
+      END

lapack-netlib/BLAS/SRC/dsymv.f

@@ -0,0 +1,333 @@
+*> \brief \b DSYMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA,BETA
+*       INTEGER INCX,INCY,LDA,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYMV  performs the matrix-vector  operation
+*>
+*>    y := alpha*A*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are n element vectors and
+*> A is an n by n symmetric matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the array A is to be referenced as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular part of the symmetric matrix and the strictly
+*>           lower triangular part of A is not referenced.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular part of the symmetric matrix and the strictly
+*>           upper triangular part of A is not referenced.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is DOUBLE PRECISION.
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y. On exit, Y is overwritten by the updated
+*>           vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSYMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER INCX,INCY,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 5
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 7
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 10
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSYMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (N-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (N-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,N
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,N
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,N
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,N
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  y  when A is stored in upper triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  DO 50 I = 1,J - 1
+                      Y(I) = Y(I) + TEMP1*A(I,J)
+                      TEMP2 = TEMP2 + A(I,J)*X(I)
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*A(J,J) + ALPHA*TEMP2
+   60         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 80 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  IX = KX
+                  IY = KY
+                  DO 70 I = 1,J - 1
+                      Y(IY) = Y(IY) + TEMP1*A(I,J)
+                      TEMP2 = TEMP2 + A(I,J)*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*A(J,J) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y  when A is stored in lower triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 100 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  Y(J) = Y(J) + TEMP1*A(J,J)
+                  DO 90 I = J + 1,N
+                      Y(I) = Y(I) + TEMP1*A(I,J)
+                      TEMP2 = TEMP2 + A(I,J)*X(I)
+   90             CONTINUE
+                  Y(J) = Y(J) + ALPHA*TEMP2
+  100         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 120 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  Y(JY) = Y(JY) + TEMP1*A(J,J)
+                  IX = JX
+                  IY = JY
+                  DO 110 I = J + 1,N
+                      IX = IX + INCX
+                      IY = IY + INCY
+                      Y(IY) = Y(IY) + TEMP1*A(I,J)
+                      TEMP2 = TEMP2 + A(I,J)*X(IX)
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYMV .
+*
+      END

lapack-netlib/BLAS/SRC/dsyr.f

@@ -0,0 +1,263 @@
+*> \brief \b DSYR
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA
+*       INTEGER INCX,LDA,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYR   performs the symmetric rank 1 operation
+*>
+*>    A := alpha*x*x**T + A,
+*>
+*> where alpha is a real scalar, x is an n element vector and A is an
+*> n by n symmetric matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the array A is to be referenced as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular part of the symmetric matrix and the strictly
+*>           lower triangular part of A is not referenced. On exit, the
+*>           upper triangular part of the array A is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular part of the symmetric matrix and the strictly
+*>           upper triangular part of A is not referenced. On exit, the
+*>           lower triangular part of the array A is overwritten by the
+*>           lower triangular part of the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSYR(UPLO,N,ALPHA,X,INCX,A,LDA)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,J,JX,KX
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 7
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSYR  ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Set the start point in X if the increment is not unity.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  A  when A is stored in upper triangle.
+*
+          IF (INCX.EQ.1) THEN
+              DO 20 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*X(J)
+                      DO 10 I = 1,J
+                          A(I,J) = A(I,J) + X(I)*TEMP
+   10                 CONTINUE
+                  END IF
+   20         CONTINUE
+          ELSE
+              JX = KX
+              DO 40 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*X(JX)
+                      IX = KX
+                      DO 30 I = 1,J
+                          A(I,J) = A(I,J) + X(IX)*TEMP
+                          IX = IX + INCX
+   30                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+   40         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  A  when A is stored in lower triangle.
+*
+          IF (INCX.EQ.1) THEN
+              DO 60 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*X(J)
+                      DO 50 I = J,N
+                          A(I,J) = A(I,J) + X(I)*TEMP
+   50                 CONTINUE
+                  END IF
+   60         CONTINUE
+          ELSE
+              JX = KX
+              DO 80 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*X(JX)
+                      IX = JX
+                      DO 70 I = J,N
+                          A(I,J) = A(I,J) + X(IX)*TEMP
+                          IX = IX + INCX
+   70                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+   80         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYR  .
+*
+      END

lapack-netlib/BLAS/SRC/dsyr2.f

@@ -0,0 +1,298 @@
+*> \brief \b DSYR2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA
+*       INTEGER INCX,INCY,LDA,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYR2  performs the symmetric rank 2 operation
+*>
+*>    A := alpha*x*y**T + alpha*y*x**T + A,
+*>
+*> where alpha is a scalar, x and y are n element vectors and A is an n
+*> by n symmetric matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the array A is to be referenced as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the upper triangular part of A
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the lower triangular part of A
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*>          Y is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular part of the symmetric matrix and the strictly
+*>           lower triangular part of A is not referenced. On exit, the
+*>           upper triangular part of the array A is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular part of the symmetric matrix and the strictly
+*>           upper triangular part of A is not referenced. On exit, the
+*>           lower triangular part of the array A is overwritten by the
+*>           lower triangular part of the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSYR2(UPLO,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,INCY,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 7
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSYR2 ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Set up the start points in X and Y if the increments are not both
+*     unity.
+*
+      IF ((INCX.NE.1) .OR. (INCY.NE.1)) THEN
+          IF (INCX.GT.0) THEN
+              KX = 1
+          ELSE
+              KX = 1 - (N-1)*INCX
+          END IF
+          IF (INCY.GT.0) THEN
+              KY = 1
+          ELSE
+              KY = 1 - (N-1)*INCY
+          END IF
+          JX = KX
+          JY = KY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the triangular part
+*     of A.
+*
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  A  when A is stored in the upper triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 20 J = 1,N
+                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*Y(J)
+                      TEMP2 = ALPHA*X(J)
+                      DO 10 I = 1,J
+                          A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
+   10                 CONTINUE
+                  END IF
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*Y(JY)
+                      TEMP2 = ALPHA*X(JX)
+                      IX = KX
+                      IY = KY
+                      DO 30 I = 1,J
+                          A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
+                          IX = IX + INCX
+                          IY = IY + INCY
+   30                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  JY = JY + INCY
+   40         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  A  when A is stored in the lower triangle.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  IF ((X(J).NE.ZERO) .OR. (Y(J).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*Y(J)
+                      TEMP2 = ALPHA*X(J)
+                      DO 50 I = J,N
+                          A(I,J) = A(I,J) + X(I)*TEMP1 + Y(I)*TEMP2
+   50                 CONTINUE
+                  END IF
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  IF ((X(JX).NE.ZERO) .OR. (Y(JY).NE.ZERO)) THEN
+                      TEMP1 = ALPHA*Y(JY)
+                      TEMP2 = ALPHA*X(JX)
+                      IX = JX
+                      IY = JY
+                      DO 70 I = J,N
+                          A(I,J) = A(I,J) + X(IX)*TEMP1 + Y(IY)*TEMP2
+                          IX = IX + INCX
+                          IY = IY + INCY
+   70                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  JY = JY + INCY
+   80         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYR2 .
+*
+      END

lapack-netlib/BLAS/SRC/dsyr2k.f

@@ -0,0 +1,399 @@
+*> \brief \b DSYR2K
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA,BETA
+*       INTEGER K,LDA,LDB,LDC,N
+*       CHARACTER TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYR2K  performs one of the symmetric rank 2k operations
+*>
+*>    C := alpha*A*B**T + alpha*B*A**T + beta*C,
+*>
+*> or
+*>
+*>    C := alpha*A**T*B + alpha*B**T*A + beta*C,
+*>
+*> where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
+*> and  A and B  are  n by k  matrices  in the  first  case  and  k by n
+*> matrices in the second case.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*>           triangular  part  of the  array  C  is to be  referenced  as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry,  TRANS  specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   C := alpha*A*B**T + alpha*B*A**T +
+*>                                        beta*C.
+*>
+*>              TRANS = 'T' or 't'   C := alpha*A**T*B + alpha*B**T*A +
+*>                                        beta*C.
+*>
+*>              TRANS = 'C' or 'c'   C := alpha*A**T*B + alpha*B**T*A +
+*>                                        beta*C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry,  N specifies the order of the matrix C.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*>           of  columns  of the  matrices  A and B,  and on  entry  with
+*>           TRANS = 'T' or 't' or 'C' or 'c',  K  specifies  the  number
+*>           of rows of the matrices  A and B.  K must be at least  zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*>           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*>           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*>           part of the array  A  must contain the matrix  A,  otherwise
+*>           the leading  k by n  part of the array  A  must contain  the
+*>           matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*>           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*>           be at least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+*>           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*>           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*>           part of the array  B  must contain the matrix  B,  otherwise
+*>           the leading  k by n  part of the array  B  must contain  the
+*>           matrix B.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*>           then  LDB must be at least  max( 1, n ), otherwise  LDB must
+*>           be at least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is DOUBLE PRECISION.
+*>           On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*>           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*>           upper triangular part of the array C must contain the upper
+*>           triangular part  of the  symmetric matrix  and the strictly
+*>           lower triangular part of C is not referenced.  On exit, the
+*>           upper triangular part of the array  C is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*>           lower triangular part of the array C must contain the lower
+*>           triangular part  of the  symmetric matrix  and the strictly
+*>           upper triangular part of C is not referenced.  On exit, the
+*>           lower triangular part of the array  C is overwritten by the
+*>           lower triangular part of the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSYR2K(UPLO,TRANS,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER K,LDA,LDB,LDC,N
+      CHARACTER TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP1,TEMP2
+      INTEGER I,INFO,J,L,NROWA
+      LOGICAL UPPER
+*     ..
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*
+*     Test the input parameters.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          NROWA = N
+      ELSE
+          NROWA = K
+      END IF
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
+     +         (.NOT.LSAME(TRANS,'T')) .AND.
+     +         (.NOT.LSAME(TRANS,'C'))) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (K.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 7
+      ELSE IF (LDB.LT.MAX(1,NROWA)) THEN
+          INFO = 9
+      ELSE IF (LDC.LT.MAX(1,N)) THEN
+          INFO = 12
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSYR2K',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
+     +    (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (UPPER) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 20 J = 1,N
+                      DO 10 I = 1,J
+                          C(I,J) = ZERO
+   10                 CONTINUE
+   20             CONTINUE
+              ELSE
+                  DO 40 J = 1,N
+                      DO 30 I = 1,J
+                          C(I,J) = BETA*C(I,J)
+   30                 CONTINUE
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (BETA.EQ.ZERO) THEN
+                  DO 60 J = 1,N
+                      DO 50 I = J,N
+                          C(I,J) = ZERO
+   50                 CONTINUE
+   60             CONTINUE
+              ELSE
+                  DO 80 J = 1,N
+                      DO 70 I = J,N
+                          C(I,J) = BETA*C(I,J)
+   70                 CONTINUE
+   80             CONTINUE
+              END IF
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  C := alpha*A*B**T + alpha*B*A**T + C.
+*
+          IF (UPPER) THEN
+              DO 130 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 90 I = 1,J
+                          C(I,J) = ZERO
+   90                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 100 I = 1,J
+                          C(I,J) = BETA*C(I,J)
+  100                 CONTINUE
+                  END IF
+                  DO 120 L = 1,K
+                      IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
+                          TEMP1 = ALPHA*B(J,L)
+                          TEMP2 = ALPHA*A(J,L)
+                          DO 110 I = 1,J
+                              C(I,J) = C(I,J) + A(I,L)*TEMP1 +
+     +                                 B(I,L)*TEMP2
+  110                     CONTINUE
+                      END IF
+  120             CONTINUE
+  130         CONTINUE
+          ELSE
+              DO 180 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 140 I = J,N
+                          C(I,J) = ZERO
+  140                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 150 I = J,N
+                          C(I,J) = BETA*C(I,J)
+  150                 CONTINUE
+                  END IF
+                  DO 170 L = 1,K
+                      IF ((A(J,L).NE.ZERO) .OR. (B(J,L).NE.ZERO)) THEN
+                          TEMP1 = ALPHA*B(J,L)
+                          TEMP2 = ALPHA*A(J,L)
+                          DO 160 I = J,N
+                              C(I,J) = C(I,J) + A(I,L)*TEMP1 +
+     +                                 B(I,L)*TEMP2
+  160                     CONTINUE
+                      END IF
+  170             CONTINUE
+  180         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  C := alpha*A**T*B + alpha*B**T*A + C.
+*
+          IF (UPPER) THEN
+              DO 210 J = 1,N
+                  DO 200 I = 1,J
+                      TEMP1 = ZERO
+                      TEMP2 = ZERO
+                      DO 190 L = 1,K
+                          TEMP1 = TEMP1 + A(L,I)*B(L,J)
+                          TEMP2 = TEMP2 + B(L,I)*A(L,J)
+  190                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
+     +                             ALPHA*TEMP2
+                      END IF
+  200             CONTINUE
+  210         CONTINUE
+          ELSE
+              DO 240 J = 1,N
+                  DO 230 I = J,N
+                      TEMP1 = ZERO
+                      TEMP2 = ZERO
+                      DO 220 L = 1,K
+                          TEMP1 = TEMP1 + A(L,I)*B(L,J)
+                          TEMP2 = TEMP2 + B(L,I)*A(L,J)
+  220                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP1 + ALPHA*TEMP2
+                      ELSE
+                          C(I,J) = BETA*C(I,J) + ALPHA*TEMP1 +
+     +                             ALPHA*TEMP2
+                      END IF
+  230             CONTINUE
+  240         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYR2K.
+*
+      END

lapack-netlib/BLAS/SRC/dsyrk.f

@@ -0,0 +1,364 @@
+*> \brief \b DSYRK
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA,BETA
+*       INTEGER K,LDA,LDC,N
+*       CHARACTER TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DSYRK  performs one of the symmetric rank k operations
+*>
+*>    C := alpha*A*A**T + beta*C,
+*>
+*> or
+*>
+*>    C := alpha*A**T*A + beta*C,
+*>
+*> where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
+*> and  A  is an  n by k  matrix in the first case and a  k by n  matrix
+*> in the second case.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On  entry,   UPLO  specifies  whether  the  upper  or  lower
+*>           triangular  part  of the  array  C  is to be  referenced  as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   Only the  upper triangular part of  C
+*>                                  is to be referenced.
+*>
+*>              UPLO = 'L' or 'l'   Only the  lower triangular part of  C
+*>                                  is to be referenced.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry,  TRANS  specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   C := alpha*A*A**T + beta*C.
+*>
+*>              TRANS = 'T' or 't'   C := alpha*A**T*A + beta*C.
+*>
+*>              TRANS = 'C' or 'c'   C := alpha*A**T*A + beta*C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry,  N specifies the order of the matrix C.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with  TRANS = 'N' or 'n',  K  specifies  the number
+*>           of  columns   of  the   matrix   A,   and  on   entry   with
+*>           TRANS = 'T' or 't' or 'C' or 'c',  K  specifies  the  number
+*>           of rows of the matrix  A.  K must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+*>           k  when  TRANS = 'N' or 'n',  and is  n  otherwise.
+*>           Before entry with  TRANS = 'N' or 'n',  the  leading  n by k
+*>           part of the array  A  must contain the matrix  A,  otherwise
+*>           the leading  k by n  part of the array  A  must contain  the
+*>           matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in  the  calling  (sub)  program.   When  TRANS = 'N' or 'n'
+*>           then  LDA must be at least  max( 1, n ), otherwise  LDA must
+*>           be at least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is DOUBLE PRECISION.
+*>           On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+*>           Before entry  with  UPLO = 'U' or 'u',  the leading  n by n
+*>           upper triangular part of the array C must contain the upper
+*>           triangular part  of the  symmetric matrix  and the strictly
+*>           lower triangular part of C is not referenced.  On exit, the
+*>           upper triangular part of the array  C is overwritten by the
+*>           upper triangular part of the updated matrix.
+*>           Before entry  with  UPLO = 'L' or 'l',  the leading  n by n
+*>           lower triangular part of the array C must contain the lower
+*>           triangular part  of the  symmetric matrix  and the strictly
+*>           upper triangular part of C is not referenced.  On exit, the
+*>           lower triangular part of the array  C is overwritten by the
+*>           lower triangular part of the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, n ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DSYRK(UPLO,TRANS,N,K,ALPHA,A,LDA,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER K,LDA,LDC,N
+      CHARACTER TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,J,L,NROWA
+      LOGICAL UPPER
+*     ..
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*
+*     Test the input parameters.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          NROWA = N
+      ELSE
+          NROWA = K
+      END IF
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.LSAME(TRANS,'N')) .AND.
+     +         (.NOT.LSAME(TRANS,'T')) .AND.
+     +         (.NOT.LSAME(TRANS,'C'))) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (K.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 7
+      ELSE IF (LDC.LT.MAX(1,N)) THEN
+          INFO = 10
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DSYRK ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. (((ALPHA.EQ.ZERO).OR.
+     +    (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (UPPER) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 20 J = 1,N
+                      DO 10 I = 1,J
+                          C(I,J) = ZERO
+   10                 CONTINUE
+   20             CONTINUE
+              ELSE
+                  DO 40 J = 1,N
+                      DO 30 I = 1,J
+                          C(I,J) = BETA*C(I,J)
+   30                 CONTINUE
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (BETA.EQ.ZERO) THEN
+                  DO 60 J = 1,N
+                      DO 50 I = J,N
+                          C(I,J) = ZERO
+   50                 CONTINUE
+   60             CONTINUE
+              ELSE
+                  DO 80 J = 1,N
+                      DO 70 I = J,N
+                          C(I,J) = BETA*C(I,J)
+   70                 CONTINUE
+   80             CONTINUE
+              END IF
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  C := alpha*A*A**T + beta*C.
+*
+          IF (UPPER) THEN
+              DO 130 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 90 I = 1,J
+                          C(I,J) = ZERO
+   90                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 100 I = 1,J
+                          C(I,J) = BETA*C(I,J)
+  100                 CONTINUE
+                  END IF
+                  DO 120 L = 1,K
+                      IF (A(J,L).NE.ZERO) THEN
+                          TEMP = ALPHA*A(J,L)
+                          DO 110 I = 1,J
+                              C(I,J) = C(I,J) + TEMP*A(I,L)
+  110                     CONTINUE
+                      END IF
+  120             CONTINUE
+  130         CONTINUE
+          ELSE
+              DO 180 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 140 I = J,N
+                          C(I,J) = ZERO
+  140                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 150 I = J,N
+                          C(I,J) = BETA*C(I,J)
+  150                 CONTINUE
+                  END IF
+                  DO 170 L = 1,K
+                      IF (A(J,L).NE.ZERO) THEN
+                          TEMP = ALPHA*A(J,L)
+                          DO 160 I = J,N
+                              C(I,J) = C(I,J) + TEMP*A(I,L)
+  160                     CONTINUE
+                      END IF
+  170             CONTINUE
+  180         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  C := alpha*A**T*A + beta*C.
+*
+          IF (UPPER) THEN
+              DO 210 J = 1,N
+                  DO 200 I = 1,J
+                      TEMP = ZERO
+                      DO 190 L = 1,K
+                          TEMP = TEMP + A(L,I)*A(L,J)
+  190                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  200             CONTINUE
+  210         CONTINUE
+          ELSE
+              DO 240 J = 1,N
+                  DO 230 I = J,N
+                      TEMP = ZERO
+                      DO 220 L = 1,K
+                          TEMP = TEMP + A(L,I)*A(L,J)
+  220                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  230             CONTINUE
+  240         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DSYRK .
+*
+      END

lapack-netlib/BLAS/SRC/dtbmv.f

@@ -0,0 +1,398 @@
+*> \brief \b DTBMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,K,LDA,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTBMV  performs one of the matrix-vector operations
+*>
+*>    x := A*x,   or   x := A**T*x,
+*>
+*> where x is an n element vector and  A is an n by n unit, or non-unit,
+*> upper or lower triangular band matrix, with ( k + 1 ) diagonals.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   x := A*x.
+*>
+*>              TRANS = 'T' or 't'   x := A**T*x.
+*>
+*>              TRANS = 'C' or 'c'   x := A**T*x.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with UPLO = 'U' or 'u', K specifies the number of
+*>           super-diagonals of the matrix A.
+*>           On entry with UPLO = 'L' or 'l', K specifies the number of
+*>           sub-diagonals of the matrix A.
+*>           K must satisfy  0 .le. K.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*>           by n part of the array A must contain the upper triangular
+*>           band part of the matrix of coefficients, supplied column by
+*>           column, with the leading diagonal of the matrix in row
+*>           ( k + 1 ) of the array, the first super-diagonal starting at
+*>           position 2 in row k, and so on. The top left k by k triangle
+*>           of the array A is not referenced.
+*>           The following program segment will transfer an upper
+*>           triangular band matrix from conventional full matrix storage
+*>           to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = K + 1 - J
+*>                    DO 10, I = MAX( 1, J - K ), J
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*>           by n part of the array A must contain the lower triangular
+*>           band part of the matrix of coefficients, supplied column by
+*>           column, with the leading diagonal of the matrix in row 1 of
+*>           the array, the first sub-diagonal starting at position 1 in
+*>           row 2, and so on. The bottom right k by k triangle of the
+*>           array A is not referenced.
+*>           The following program segment will transfer a lower
+*>           triangular band matrix from conventional full matrix storage
+*>           to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = 1 - J
+*>                    DO 10, I = J, MIN( N, J + K )
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Note that when DIAG = 'U' or 'u' the elements of the array A
+*>           corresponding to the diagonal elements of the matrix are not
+*>           referenced, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( k + 1 ).
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x. On exit, X is overwritten with the
+*>           tranformed vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTBMV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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,K,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
+      LOGICAL NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX,MIN
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (K.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT. (K+1)) THEN
+          INFO = 7
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DTBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX   too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*         Form  x := A*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          L = KPLUS1 - J
+                          DO 10 I = MAX(1,J-K),J - 1
+                              X(I) = X(I) + TEMP*A(L+I,J)
+   10                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J)
+                      END IF
+   20             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 40 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          L = KPLUS1 - J
+                          DO 30 I = MAX(1,J-K),J - 1
+                              X(IX) = X(IX) + TEMP*A(L+I,J)
+                              IX = IX + INCX
+   30                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J)
+                      END IF
+                      JX = JX + INCX
+                      IF (J.GT.K) KX = KX + INCX
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          L = 1 - J
+                          DO 50 I = MIN(N,J+K),J + 1,-1
+                              X(I) = X(I) + TEMP*A(L+I,J)
+   50                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(1,J)
+                      END IF
+   60             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 80 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          L = 1 - J
+                          DO 70 I = MIN(N,J+K),J + 1,-1
+                              X(IX) = X(IX) + TEMP*A(L+I,J)
+                              IX = IX - INCX
+   70                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(1,J)
+                      END IF
+                      JX = JX - INCX
+                      IF ((N-J).GE.K) KX = KX - INCX
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := A**T*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 100 J = N,1,-1
+                      TEMP = X(J)
+                      L = KPLUS1 - J
+                      IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
+                      DO 90 I = J - 1,MAX(1,J-K),-1
+                          TEMP = TEMP + A(L+I,J)*X(I)
+   90                 CONTINUE
+                      X(J) = TEMP
+  100             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 120 J = N,1,-1
+                      TEMP = X(JX)
+                      KX = KX - INCX
+                      IX = KX
+                      L = KPLUS1 - J
+                      IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
+                      DO 110 I = J - 1,MAX(1,J-K),-1
+                          TEMP = TEMP + A(L+I,J)*X(IX)
+                          IX = IX - INCX
+  110                 CONTINUE
+                      X(JX) = TEMP
+                      JX = JX - INCX
+  120             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 140 J = 1,N
+                      TEMP = X(J)
+                      L = 1 - J
+                      IF (NOUNIT) TEMP = TEMP*A(1,J)
+                      DO 130 I = J + 1,MIN(N,J+K)
+                          TEMP = TEMP + A(L+I,J)*X(I)
+  130                 CONTINUE
+                      X(J) = TEMP
+  140             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 160 J = 1,N
+                      TEMP = X(JX)
+                      KX = KX + INCX
+                      IX = KX
+                      L = 1 - J
+                      IF (NOUNIT) TEMP = TEMP*A(1,J)
+                      DO 150 I = J + 1,MIN(N,J+K)
+                          TEMP = TEMP + A(L+I,J)*X(IX)
+                          IX = IX + INCX
+  150                 CONTINUE
+                      X(JX) = TEMP
+                      JX = JX + INCX
+  160             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTBMV .
+*
+      END

lapack-netlib/BLAS/SRC/dtbsv.f

@@ -0,0 +1,401 @@
+*> \brief \b DTBSV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,K,LDA,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTBSV  solves one of the systems of equations
+*>
+*>    A*x = b,   or   A**T*x = b,
+*>
+*> where b and x are n element vectors and A is an n by n unit, or
+*> non-unit, upper or lower triangular band matrix, with ( k + 1 )
+*> diagonals.
+*>
+*> No test for singularity or near-singularity is included in this
+*> routine. Such tests must be performed before calling this routine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the equations to be solved as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   A*x = b.
+*>
+*>              TRANS = 'T' or 't'   A**T*x = b.
+*>
+*>              TRANS = 'C' or 'c'   A**T*x = b.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry with UPLO = 'U' or 'u', K specifies the number of
+*>           super-diagonals of the matrix A.
+*>           On entry with UPLO = 'L' or 'l', K specifies the number of
+*>           sub-diagonals of the matrix A.
+*>           K must satisfy  0 .le. K.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*>           by n part of the array A must contain the upper triangular
+*>           band part of the matrix of coefficients, supplied column by
+*>           column, with the leading diagonal of the matrix in row
+*>           ( k + 1 ) of the array, the first super-diagonal starting at
+*>           position 2 in row k, and so on. The top left k by k triangle
+*>           of the array A is not referenced.
+*>           The following program segment will transfer an upper
+*>           triangular band matrix from conventional full matrix storage
+*>           to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = K + 1 - J
+*>                    DO 10, I = MAX( 1, J - K ), J
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*>           by n part of the array A must contain the lower triangular
+*>           band part of the matrix of coefficients, supplied column by
+*>           column, with the leading diagonal of the matrix in row 1 of
+*>           the array, the first sub-diagonal starting at position 1 in
+*>           row 2, and so on. The bottom right k by k triangle of the
+*>           array A is not referenced.
+*>           The following program segment will transfer a lower
+*>           triangular band matrix from conventional full matrix storage
+*>           to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = 1 - J
+*>                    DO 10, I = J, MIN( N, J + K )
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Note that when DIAG = 'U' or 'u' the elements of the array A
+*>           corresponding to the diagonal elements of the matrix are not
+*>           referenced, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( k + 1 ).
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element right-hand side vector b. On exit, X is overwritten
+*>           with the solution vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTBSV(UPLO,TRANS,DIAG,N,K,A,LDA,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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,K,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
+      LOGICAL NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX,MIN
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (K.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT. (K+1)) THEN
+          INFO = 7
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DTBSV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed by sequentially with one pass through A.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x := inv( A )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          L = KPLUS1 - J
+                          IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J)
+                          TEMP = X(J)
+                          DO 10 I = J - 1,MAX(1,J-K),-1
+                              X(I) = X(I) - TEMP*A(L+I,J)
+   10                     CONTINUE
+                      END IF
+   20             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 40 J = N,1,-1
+                      KX = KX - INCX
+                      IF (X(JX).NE.ZERO) THEN
+                          IX = KX
+                          L = KPLUS1 - J
+                          IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J)
+                          TEMP = X(JX)
+                          DO 30 I = J - 1,MAX(1,J-K),-1
+                              X(IX) = X(IX) - TEMP*A(L+I,J)
+                              IX = IX - INCX
+   30                     CONTINUE
+                      END IF
+                      JX = JX - INCX
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          L = 1 - J
+                          IF (NOUNIT) X(J) = X(J)/A(1,J)
+                          TEMP = X(J)
+                          DO 50 I = J + 1,MIN(N,J+K)
+                              X(I) = X(I) - TEMP*A(L+I,J)
+   50                     CONTINUE
+                      END IF
+   60             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 80 J = 1,N
+                      KX = KX + INCX
+                      IF (X(JX).NE.ZERO) THEN
+                          IX = KX
+                          L = 1 - J
+                          IF (NOUNIT) X(JX) = X(JX)/A(1,J)
+                          TEMP = X(JX)
+                          DO 70 I = J + 1,MIN(N,J+K)
+                              X(IX) = X(IX) - TEMP*A(L+I,J)
+                              IX = IX + INCX
+   70                     CONTINUE
+                      END IF
+                      JX = JX + INCX
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := inv( A**T)*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KPLUS1 = K + 1
+              IF (INCX.EQ.1) THEN
+                  DO 100 J = 1,N
+                      TEMP = X(J)
+                      L = KPLUS1 - J
+                      DO 90 I = MAX(1,J-K),J - 1
+                          TEMP = TEMP - A(L+I,J)*X(I)
+   90                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
+                      X(J) = TEMP
+  100             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 120 J = 1,N
+                      TEMP = X(JX)
+                      IX = KX
+                      L = KPLUS1 - J
+                      DO 110 I = MAX(1,J-K),J - 1
+                          TEMP = TEMP - A(L+I,J)*X(IX)
+                          IX = IX + INCX
+  110                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
+                      X(JX) = TEMP
+                      JX = JX + INCX
+                      IF (J.GT.K) KX = KX + INCX
+  120             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 140 J = N,1,-1
+                      TEMP = X(J)
+                      L = 1 - J
+                      DO 130 I = MIN(N,J+K),J + 1,-1
+                          TEMP = TEMP - A(L+I,J)*X(I)
+  130                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/A(1,J)
+                      X(J) = TEMP
+  140             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 160 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = KX
+                      L = 1 - J
+                      DO 150 I = MIN(N,J+K),J + 1,-1
+                          TEMP = TEMP - A(L+I,J)*X(IX)
+                          IX = IX - INCX
+  150                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/A(1,J)
+                      X(JX) = TEMP
+                      JX = JX - INCX
+                      IF ((N-J).GE.K) KX = KX - INCX
+  160             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTBSV .
+*
+      END

lapack-netlib/BLAS/SRC/dtpmv.f

@@ -0,0 +1,352 @@
+*> \brief \b DTPMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION AP(*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTPMV  performs one of the matrix-vector operations
+*>
+*>    x := A*x,   or   x := A**T*x,
+*>
+*> where x is an n element vector and  A is an n by n unit, or non-unit,
+*> upper or lower triangular matrix, supplied in packed form.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   x := A*x.
+*>
+*>              TRANS = 'T' or 't'   x := A**T*x.
+*>
+*>              TRANS = 'C' or 'c'   x := A**T*x.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] AP
+*> \verbatim
+*>          AP is DOUBLE PRECISION array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with  UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular matrix packed sequentially,
+*>           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*>           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+*>           respectively, and so on.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular matrix packed sequentially,
+*>           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*>           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+*>           respectively, and so on.
+*>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*>           A are not referenced, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x. On exit, X is overwritten with the
+*>           tranformed vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTPMV(UPLO,TRANS,DIAG,N,AP,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION AP(*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,J,JX,K,KK,KX
+      LOGICAL NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 7
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DTPMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of AP are
+*     accessed sequentially with one pass through AP.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x:= A*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KK = 1
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          K = KK
+                          DO 10 I = 1,J - 1
+                              X(I) = X(I) + TEMP*AP(K)
+                              K = K + 1
+   10                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*AP(KK+J-1)
+                      END IF
+                      KK = KK + J
+   20             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 40 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 30 K = KK,KK + J - 2
+                              X(IX) = X(IX) + TEMP*AP(K)
+                              IX = IX + INCX
+   30                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*AP(KK+J-1)
+                      END IF
+                      JX = JX + INCX
+                      KK = KK + J
+   40             CONTINUE
+              END IF
+          ELSE
+              KK = (N* (N+1))/2
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          K = KK
+                          DO 50 I = N,J + 1,-1
+                              X(I) = X(I) + TEMP*AP(K)
+                              K = K - 1
+   50                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*AP(KK-N+J)
+                      END IF
+                      KK = KK - (N-J+1)
+   60             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 80 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 70 K = KK,KK - (N- (J+1)),-1
+                              X(IX) = X(IX) + TEMP*AP(K)
+                              IX = IX - INCX
+   70                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*AP(KK-N+J)
+                      END IF
+                      JX = JX - INCX
+                      KK = KK - (N-J+1)
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := A**T*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KK = (N* (N+1))/2
+              IF (INCX.EQ.1) THEN
+                  DO 100 J = N,1,-1
+                      TEMP = X(J)
+                      IF (NOUNIT) TEMP = TEMP*AP(KK)
+                      K = KK - 1
+                      DO 90 I = J - 1,1,-1
+                          TEMP = TEMP + AP(K)*X(I)
+                          K = K - 1
+   90                 CONTINUE
+                      X(J) = TEMP
+                      KK = KK - J
+  100             CONTINUE
+              ELSE
+                  JX = KX + (N-1)*INCX
+                  DO 120 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOUNIT) TEMP = TEMP*AP(KK)
+                      DO 110 K = KK - 1,KK - J + 1,-1
+                          IX = IX - INCX
+                          TEMP = TEMP + AP(K)*X(IX)
+  110                 CONTINUE
+                      X(JX) = TEMP
+                      JX = JX - INCX
+                      KK = KK - J
+  120             CONTINUE
+              END IF
+          ELSE
+              KK = 1
+              IF (INCX.EQ.1) THEN
+                  DO 140 J = 1,N
+                      TEMP = X(J)
+                      IF (NOUNIT) TEMP = TEMP*AP(KK)
+                      K = KK + 1
+                      DO 130 I = J + 1,N
+                          TEMP = TEMP + AP(K)*X(I)
+                          K = K + 1
+  130                 CONTINUE
+                      X(J) = TEMP
+                      KK = KK + (N-J+1)
+  140             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 160 J = 1,N
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOUNIT) TEMP = TEMP*AP(KK)
+                      DO 150 K = KK + 1,KK + N - J
+                          IX = IX + INCX
+                          TEMP = TEMP + AP(K)*X(IX)
+  150                 CONTINUE
+                      X(JX) = TEMP
+                      JX = JX + INCX
+                      KK = KK + (N-J+1)
+  160             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTPMV .
+*
+      END

lapack-netlib/BLAS/SRC/dtpsv.f

@@ -0,0 +1,354 @@
+*> \brief \b DTPSV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION AP(*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTPSV  solves one of the systems of equations
+*>
+*>    A*x = b,   or   A**T*x = b,
+*>
+*> where b and x are n element vectors and A is an n by n unit, or
+*> non-unit, upper or lower triangular matrix, supplied in packed form.
+*>
+*> No test for singularity or near-singularity is included in this
+*> routine. Such tests must be performed before calling this routine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the equations to be solved as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   A*x = b.
+*>
+*>              TRANS = 'T' or 't'   A**T*x = b.
+*>
+*>              TRANS = 'C' or 'c'   A**T*x = b.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] AP
+*> \verbatim
+*>          AP is DOUBLE PRECISION array of DIMENSION at least
+*>           ( ( n*( n + 1 ) )/2 ).
+*>           Before entry with  UPLO = 'U' or 'u', the array AP must
+*>           contain the upper triangular matrix packed sequentially,
+*>           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*>           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
+*>           respectively, and so on.
+*>           Before entry with UPLO = 'L' or 'l', the array AP must
+*>           contain the lower triangular matrix packed sequentially,
+*>           column by column, so that AP( 1 ) contains a( 1, 1 ),
+*>           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
+*>           respectively, and so on.
+*>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*>           A are not referenced, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element right-hand side vector b. On exit, X is overwritten
+*>           with the solution vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTPSV(UPLO,TRANS,DIAG,N,AP,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION AP(*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,J,JX,K,KK,KX
+      LOGICAL NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 7
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DTPSV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of AP are
+*     accessed sequentially with one pass through AP.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x := inv( A )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KK = (N* (N+1))/2
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          IF (NOUNIT) X(J) = X(J)/AP(KK)
+                          TEMP = X(J)
+                          K = KK - 1
+                          DO 10 I = J - 1,1,-1
+                              X(I) = X(I) - TEMP*AP(K)
+                              K = K - 1
+   10                     CONTINUE
+                      END IF
+                      KK = KK - J
+   20             CONTINUE
+              ELSE
+                  JX = KX + (N-1)*INCX
+                  DO 40 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          IF (NOUNIT) X(JX) = X(JX)/AP(KK)
+                          TEMP = X(JX)
+                          IX = JX
+                          DO 30 K = KK - 1,KK - J + 1,-1
+                              IX = IX - INCX
+                              X(IX) = X(IX) - TEMP*AP(K)
+   30                     CONTINUE
+                      END IF
+                      JX = JX - INCX
+                      KK = KK - J
+   40             CONTINUE
+              END IF
+          ELSE
+              KK = 1
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          IF (NOUNIT) X(J) = X(J)/AP(KK)
+                          TEMP = X(J)
+                          K = KK + 1
+                          DO 50 I = J + 1,N
+                              X(I) = X(I) - TEMP*AP(K)
+                              K = K + 1
+   50                     CONTINUE
+                      END IF
+                      KK = KK + (N-J+1)
+   60             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 80 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          IF (NOUNIT) X(JX) = X(JX)/AP(KK)
+                          TEMP = X(JX)
+                          IX = JX
+                          DO 70 K = KK + 1,KK + N - J
+                              IX = IX + INCX
+                              X(IX) = X(IX) - TEMP*AP(K)
+   70                     CONTINUE
+                      END IF
+                      JX = JX + INCX
+                      KK = KK + (N-J+1)
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := inv( A**T )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              KK = 1
+              IF (INCX.EQ.1) THEN
+                  DO 100 J = 1,N
+                      TEMP = X(J)
+                      K = KK
+                      DO 90 I = 1,J - 1
+                          TEMP = TEMP - AP(K)*X(I)
+                          K = K + 1
+   90                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/AP(KK+J-1)
+                      X(J) = TEMP
+                      KK = KK + J
+  100             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 120 J = 1,N
+                      TEMP = X(JX)
+                      IX = KX
+                      DO 110 K = KK,KK + J - 2
+                          TEMP = TEMP - AP(K)*X(IX)
+                          IX = IX + INCX
+  110                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/AP(KK+J-1)
+                      X(JX) = TEMP
+                      JX = JX + INCX
+                      KK = KK + J
+  120             CONTINUE
+              END IF
+          ELSE
+              KK = (N* (N+1))/2
+              IF (INCX.EQ.1) THEN
+                  DO 140 J = N,1,-1
+                      TEMP = X(J)
+                      K = KK
+                      DO 130 I = N,J + 1,-1
+                          TEMP = TEMP - AP(K)*X(I)
+                          K = K - 1
+  130                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/AP(KK-N+J)
+                      X(J) = TEMP
+                      KK = KK - (N-J+1)
+  140             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 160 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = KX
+                      DO 150 K = KK,KK - (N- (J+1)),-1
+                          TEMP = TEMP - AP(K)*X(IX)
+                          IX = IX - INCX
+  150                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/AP(KK-N+J)
+                      X(JX) = TEMP
+                      JX = JX - INCX
+                      KK = KK - (N-J+1)
+  160             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTPSV .
+*
+      END

lapack-netlib/BLAS/SRC/dtrmm.f

@@ -0,0 +1,415 @@
+*> \brief \b DTRMM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA
+*       INTEGER LDA,LDB,M,N
+*       CHARACTER DIAG,SIDE,TRANSA,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),B(LDB,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTRMM  performs one of the matrix-matrix operations
+*>
+*>    B := alpha*op( A )*B,   or   B := alpha*B*op( A ),
+*>
+*> where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
+*> non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
+*>
+*>    op( A ) = A   or   op( A ) = A**T.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>           On entry,  SIDE specifies whether  op( A ) multiplies B from
+*>           the left or right as follows:
+*>
+*>              SIDE = 'L' or 'l'   B := alpha*op( A )*B.
+*>
+*>              SIDE = 'R' or 'r'   B := alpha*B*op( A ).
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix A is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANSA
+*> \verbatim
+*>          TRANSA is CHARACTER*1
+*>           On entry, TRANSA specifies the form of op( A ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSA = 'N' or 'n'   op( A ) = A.
+*>
+*>              TRANSA = 'T' or 't'   op( A ) = A**T.
+*>
+*>              TRANSA = 'C' or 'c'   op( A ) = A**T.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit triangular
+*>           as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of B. M must be at
+*>           least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of B.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
+*>           zero then  A is not referenced and  B need not be set before
+*>           entry.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>           A is DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+*>           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
+*>           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
+*>           upper triangular part of the array  A must contain the upper
+*>           triangular matrix  and the strictly lower triangular part of
+*>           A is not referenced.
+*>           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
+*>           lower triangular part of the array  A must contain the lower
+*>           triangular matrix  and the strictly upper triangular part of
+*>           A is not referenced.
+*>           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
+*>           A  are not referenced either,  but are assumed to be  unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*>           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
+*>           then LDA must be at least max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+*>           Before entry,  the leading  m by n part of the array  B must
+*>           contain the matrix  B,  and  on exit  is overwritten  by the
+*>           transformed matrix.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER LDA,LDB,M,N
+      CHARACTER DIAG,SIDE,TRANSA,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),B(LDB,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,J,K,NROWA
+      LOGICAL LSIDE,NOUNIT,UPPER
+*     ..
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*
+*     Test the input parameters.
+*
+      LSIDE = LSAME(SIDE,'L')
+      IF (LSIDE) THEN
+          NROWA = M
+      ELSE
+          NROWA = N
+      END IF
+      NOUNIT = LSAME(DIAG,'N')
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 2
+      ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
+     +         (.NOT.LSAME(TRANSA,'T')) .AND.
+     +         (.NOT.LSAME(TRANSA,'C'))) THEN
+          INFO = 3
+      ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
+          INFO = 4
+      ELSE IF (M.LT.0) THEN
+          INFO = 5
+      ELSE IF (N.LT.0) THEN
+          INFO = 6
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 9
+      ELSE IF (LDB.LT.MAX(1,M)) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DTRMM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (M.EQ.0 .OR. N.EQ.0) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          DO 20 J = 1,N
+              DO 10 I = 1,M
+                  B(I,J) = ZERO
+   10         CONTINUE
+   20     CONTINUE
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSIDE) THEN
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*A*B.
+*
+              IF (UPPER) THEN
+                  DO 50 J = 1,N
+                      DO 40 K = 1,M
+                          IF (B(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*B(K,J)
+                              DO 30 I = 1,K - 1
+                                  B(I,J) = B(I,J) + TEMP*A(I,K)
+   30                         CONTINUE
+                              IF (NOUNIT) TEMP = TEMP*A(K,K)
+                              B(K,J) = TEMP
+                          END IF
+   40                 CONTINUE
+   50             CONTINUE
+              ELSE
+                  DO 80 J = 1,N
+                      DO 70 K = M,1,-1
+                          IF (B(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*B(K,J)
+                              B(K,J) = TEMP
+                              IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
+                              DO 60 I = K + 1,M
+                                  B(I,J) = B(I,J) + TEMP*A(I,K)
+   60                         CONTINUE
+                          END IF
+   70                 CONTINUE
+   80             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*A**T*B.
+*
+              IF (UPPER) THEN
+                  DO 110 J = 1,N
+                      DO 100 I = M,1,-1
+                          TEMP = B(I,J)
+                          IF (NOUNIT) TEMP = TEMP*A(I,I)
+                          DO 90 K = 1,I - 1
+                              TEMP = TEMP + A(K,I)*B(K,J)
+   90                     CONTINUE
+                          B(I,J) = ALPHA*TEMP
+  100                 CONTINUE
+  110             CONTINUE
+              ELSE
+                  DO 140 J = 1,N
+                      DO 130 I = 1,M
+                          TEMP = B(I,J)
+                          IF (NOUNIT) TEMP = TEMP*A(I,I)
+                          DO 120 K = I + 1,M
+                              TEMP = TEMP + A(K,I)*B(K,J)
+  120                     CONTINUE
+                          B(I,J) = ALPHA*TEMP
+  130                 CONTINUE
+  140             CONTINUE
+              END IF
+          END IF
+      ELSE
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*B*A.
+*
+              IF (UPPER) THEN
+                  DO 180 J = N,1,-1
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 150 I = 1,M
+                          B(I,J) = TEMP*B(I,J)
+  150                 CONTINUE
+                      DO 170 K = 1,J - 1
+                          IF (A(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*A(K,J)
+                              DO 160 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  160                         CONTINUE
+                          END IF
+  170                 CONTINUE
+  180             CONTINUE
+              ELSE
+                  DO 220 J = 1,N
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 190 I = 1,M
+                          B(I,J) = TEMP*B(I,J)
+  190                 CONTINUE
+                      DO 210 K = J + 1,N
+                          IF (A(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*A(K,J)
+                              DO 200 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  200                         CONTINUE
+                          END IF
+  210                 CONTINUE
+  220             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*B*A**T.
+*
+              IF (UPPER) THEN
+                  DO 260 K = 1,N
+                      DO 240 J = 1,K - 1
+                          IF (A(J,K).NE.ZERO) THEN
+                              TEMP = ALPHA*A(J,K)
+                              DO 230 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  230                         CONTINUE
+                          END IF
+  240                 CONTINUE
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(K,K)
+                      IF (TEMP.NE.ONE) THEN
+                          DO 250 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  250                     CONTINUE
+                      END IF
+  260             CONTINUE
+              ELSE
+                  DO 300 K = N,1,-1
+                      DO 280 J = K + 1,N
+                          IF (A(J,K).NE.ZERO) THEN
+                              TEMP = ALPHA*A(J,K)
+                              DO 270 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  270                         CONTINUE
+                          END IF
+  280                 CONTINUE
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(K,K)
+                      IF (TEMP.NE.ONE) THEN
+                          DO 290 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  290                     CONTINUE
+                      END IF
+  300             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTRMM .
+*
+      END

lapack-netlib/BLAS/SRC/dtrmv.f

@@ -0,0 +1,342 @@
+*> \brief \b DTRMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,LDA,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTRMV  performs one of the matrix-vector operations
+*>
+*>    x := A*x,   or   x := A**T*x,
+*>
+*> where x is an n element vector and  A is an n by n unit, or non-unit,
+*> upper or lower triangular matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   x := A*x.
+*>
+*>              TRANS = 'T' or 't'   x := A**T*x.
+*>
+*>              TRANS = 'C' or 'c'   x := A**T*x.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular matrix and the strictly lower triangular part of
+*>           A is not referenced.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular matrix and the strictly upper triangular part of
+*>           A is not referenced.
+*>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*>           A are not referenced either, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element vector x. On exit, X is overwritten with the
+*>           tranformed vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,J,JX,KX
+      LOGICAL NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DTRMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x := A*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          DO 10 I = 1,J - 1
+                              X(I) = X(I) + TEMP*A(I,J)
+   10                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(J,J)
+                      END IF
+   20             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 40 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 30 I = 1,J - 1
+                              X(IX) = X(IX) + TEMP*A(I,J)
+                              IX = IX + INCX
+   30                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(J,J)
+                      END IF
+                      JX = JX + INCX
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          DO 50 I = N,J + 1,-1
+                              X(I) = X(I) + TEMP*A(I,J)
+   50                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(J,J)
+                      END IF
+   60             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 80 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 70 I = N,J + 1,-1
+                              X(IX) = X(IX) + TEMP*A(I,J)
+                              IX = IX - INCX
+   70                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(J,J)
+                      END IF
+                      JX = JX - INCX
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := A**T*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 100 J = N,1,-1
+                      TEMP = X(J)
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 90 I = J - 1,1,-1
+                          TEMP = TEMP + A(I,J)*X(I)
+   90                 CONTINUE
+                      X(J) = TEMP
+  100             CONTINUE
+              ELSE
+                  JX = KX + (N-1)*INCX
+                  DO 120 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 110 I = J - 1,1,-1
+                          IX = IX - INCX
+                          TEMP = TEMP + A(I,J)*X(IX)
+  110                 CONTINUE
+                      X(JX) = TEMP
+                      JX = JX - INCX
+  120             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 140 J = 1,N
+                      TEMP = X(J)
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 130 I = J + 1,N
+                          TEMP = TEMP + A(I,J)*X(I)
+  130                 CONTINUE
+                      X(J) = TEMP
+  140             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 160 J = 1,N
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 150 I = J + 1,N
+                          IX = IX + INCX
+                          TEMP = TEMP + A(I,J)*X(IX)
+  150                 CONTINUE
+                      X(JX) = TEMP
+                      JX = JX + INCX
+  160             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTRMV .
+*
+      END

lapack-netlib/BLAS/SRC/dtrsm.f

@@ -0,0 +1,443 @@
+*> \brief \b DTRSM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+* 
+*       .. Scalar Arguments ..
+*       DOUBLE PRECISION ALPHA
+*       INTEGER LDA,LDB,M,N
+*       CHARACTER DIAG,SIDE,TRANSA,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),B(LDB,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTRSM  solves one of the matrix equations
+*>
+*>    op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,
+*>
+*> where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+*> non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
+*>
+*>    op( A ) = A   or   op( A ) = A**T.
+*>
+*> The matrix X is overwritten on B.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>           On entry, SIDE specifies whether op( A ) appears on the left
+*>           or right of X as follows:
+*>
+*>              SIDE = 'L' or 'l'   op( A )*X = alpha*B.
+*>
+*>              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix A is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANSA
+*> \verbatim
+*>          TRANSA is CHARACTER*1
+*>           On entry, TRANSA specifies the form of op( A ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSA = 'N' or 'n'   op( A ) = A.
+*>
+*>              TRANSA = 'T' or 't'   op( A ) = A**T.
+*>
+*>              TRANSA = 'C' or 'c'   op( A ) = A**T.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit triangular
+*>           as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of B. M must be at
+*>           least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of B.  N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is DOUBLE PRECISION.
+*>           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
+*>           zero then  A is not referenced and  B need not be set before
+*>           entry.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, k ),
+*>           where k is m when SIDE = 'L' or 'l'  
+*>             and k is n when SIDE = 'R' or 'r'.
+*>           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
+*>           upper triangular part of the array  A must contain the upper
+*>           triangular matrix  and the strictly lower triangular part of
+*>           A is not referenced.
+*>           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
+*>           lower triangular part of the array  A must contain the lower
+*>           triangular matrix  and the strictly upper triangular part of
+*>           A is not referenced.
+*>           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
+*>           A  are not referenced either,  but are assumed to be  unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*>           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
+*>           then LDA must be at least max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+*>           Before entry,  the leading  m by n part of the array  B must
+*>           contain  the  right-hand  side  matrix  B,  and  on exit  is
+*>           overwritten by the solution matrix  X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+*
+*  -- Reference BLAS level3 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER LDA,LDB,M,N
+      CHARACTER DIAG,SIDE,TRANSA,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),B(LDB,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,J,K,NROWA
+      LOGICAL LSIDE,NOUNIT,UPPER
+*     ..
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*
+*     Test the input parameters.
+*
+      LSIDE = LSAME(SIDE,'L')
+      IF (LSIDE) THEN
+          NROWA = M
+      ELSE
+          NROWA = N
+      END IF
+      NOUNIT = LSAME(DIAG,'N')
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 2
+      ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
+     +         (.NOT.LSAME(TRANSA,'T')) .AND.
+     +         (.NOT.LSAME(TRANSA,'C'))) THEN
+          INFO = 3
+      ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
+          INFO = 4
+      ELSE IF (M.LT.0) THEN
+          INFO = 5
+      ELSE IF (N.LT.0) THEN
+          INFO = 6
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 9
+      ELSE IF (LDB.LT.MAX(1,M)) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DTRSM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (M.EQ.0 .OR. N.EQ.0) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          DO 20 J = 1,N
+              DO 10 I = 1,M
+                  B(I,J) = ZERO
+   10         CONTINUE
+   20     CONTINUE
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSIDE) THEN
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*inv( A )*B.
+*
+              IF (UPPER) THEN
+                  DO 60 J = 1,N
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 30 I = 1,M
+                              B(I,J) = ALPHA*B(I,J)
+   30                     CONTINUE
+                      END IF
+                      DO 50 K = M,1,-1
+                          IF (B(K,J).NE.ZERO) THEN
+                              IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
+                              DO 40 I = 1,K - 1
+                                  B(I,J) = B(I,J) - B(K,J)*A(I,K)
+   40                         CONTINUE
+                          END IF
+   50                 CONTINUE
+   60             CONTINUE
+              ELSE
+                  DO 100 J = 1,N
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 70 I = 1,M
+                              B(I,J) = ALPHA*B(I,J)
+   70                     CONTINUE
+                      END IF
+                      DO 90 K = 1,M
+                          IF (B(K,J).NE.ZERO) THEN
+                              IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
+                              DO 80 I = K + 1,M
+                                  B(I,J) = B(I,J) - B(K,J)*A(I,K)
+   80                         CONTINUE
+                          END IF
+   90                 CONTINUE
+  100             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*inv( A**T )*B.
+*
+              IF (UPPER) THEN
+                  DO 130 J = 1,N
+                      DO 120 I = 1,M
+                          TEMP = ALPHA*B(I,J)
+                          DO 110 K = 1,I - 1
+                              TEMP = TEMP - A(K,I)*B(K,J)
+  110                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(I,I)
+                          B(I,J) = TEMP
+  120                 CONTINUE
+  130             CONTINUE
+              ELSE
+                  DO 160 J = 1,N
+                      DO 150 I = M,1,-1
+                          TEMP = ALPHA*B(I,J)
+                          DO 140 K = I + 1,M
+                              TEMP = TEMP - A(K,I)*B(K,J)
+  140                     CONTINUE
+                          IF (NOUNIT) TEMP = TEMP/A(I,I)
+                          B(I,J) = TEMP
+  150                 CONTINUE
+  160             CONTINUE
+              END IF
+          END IF
+      ELSE
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*B*inv( A ).
+*
+              IF (UPPER) THEN
+                  DO 210 J = 1,N
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 170 I = 1,M
+                              B(I,J) = ALPHA*B(I,J)
+  170                     CONTINUE
+                      END IF
+                      DO 190 K = 1,J - 1
+                          IF (A(K,J).NE.ZERO) THEN
+                              DO 180 I = 1,M
+                                  B(I,J) = B(I,J) - A(K,J)*B(I,K)
+  180                         CONTINUE
+                          END IF
+  190                 CONTINUE
+                      IF (NOUNIT) THEN
+                          TEMP = ONE/A(J,J)
+                          DO 200 I = 1,M
+                              B(I,J) = TEMP*B(I,J)
+  200                     CONTINUE
+                      END IF
+  210             CONTINUE
+              ELSE
+                  DO 260 J = N,1,-1
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 220 I = 1,M
+                              B(I,J) = ALPHA*B(I,J)
+  220                     CONTINUE
+                      END IF
+                      DO 240 K = J + 1,N
+                          IF (A(K,J).NE.ZERO) THEN
+                              DO 230 I = 1,M
+                                  B(I,J) = B(I,J) - A(K,J)*B(I,K)
+  230                         CONTINUE
+                          END IF
+  240                 CONTINUE
+                      IF (NOUNIT) THEN
+                          TEMP = ONE/A(J,J)
+                          DO 250 I = 1,M
+                              B(I,J) = TEMP*B(I,J)
+  250                     CONTINUE
+                      END IF
+  260             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*B*inv( A**T ).
+*
+              IF (UPPER) THEN
+                  DO 310 K = N,1,-1
+                      IF (NOUNIT) THEN
+                          TEMP = ONE/A(K,K)
+                          DO 270 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  270                     CONTINUE
+                      END IF
+                      DO 290 J = 1,K - 1
+                          IF (A(J,K).NE.ZERO) THEN
+                              TEMP = A(J,K)
+                              DO 280 I = 1,M
+                                  B(I,J) = B(I,J) - TEMP*B(I,K)
+  280                         CONTINUE
+                          END IF
+  290                 CONTINUE
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 300 I = 1,M
+                              B(I,K) = ALPHA*B(I,K)
+  300                     CONTINUE
+                      END IF
+  310             CONTINUE
+              ELSE
+                  DO 360 K = 1,N
+                      IF (NOUNIT) THEN
+                          TEMP = ONE/A(K,K)
+                          DO 320 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  320                     CONTINUE
+                      END IF
+                      DO 340 J = K + 1,N
+                          IF (A(J,K).NE.ZERO) THEN
+                              TEMP = A(J,K)
+                              DO 330 I = 1,M
+                                  B(I,J) = B(I,J) - TEMP*B(I,K)
+  330                         CONTINUE
+                          END IF
+  340                 CONTINUE
+                      IF (ALPHA.NE.ONE) THEN
+                          DO 350 I = 1,M
+                              B(I,K) = ALPHA*B(I,K)
+  350                     CONTINUE
+                      END IF
+  360             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTRSM .
+*
+      END

lapack-netlib/BLAS/SRC/dtrsv.f

@@ -0,0 +1,338 @@
+*> \brief \b DTRSV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,LDA,N
+*       CHARACTER DIAG,TRANS,UPLO
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A(LDA,*),X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTRSV  solves one of the systems of equations
+*>
+*>    A*x = b,   or   A**T*x = b,
+*>
+*> where b and x are n element vectors and A is an n by n unit, or
+*> non-unit, upper or lower triangular matrix.
+*>
+*> No test for singularity or near-singularity is included in this
+*> routine. Such tests must be performed before calling this routine.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the matrix is an upper or
+*>           lower triangular matrix as follows:
+*>
+*>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*>
+*>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the equations to be solved as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   A*x = b.
+*>
+*>              TRANS = 'T' or 't'   A**T*x = b.
+*>
+*>              TRANS = 'C' or 'c'   A**T*x = b.
+*> \endverbatim
+*>
+*> \param[in] DIAG
+*> \verbatim
+*>          DIAG is CHARACTER*1
+*>           On entry, DIAG specifies whether or not A is unit
+*>           triangular as follows:
+*>
+*>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*>
+*>              DIAG = 'N' or 'n'   A is not assumed to be unit
+*>                                  triangular.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+*>           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*>           upper triangular part of the array A must contain the upper
+*>           triangular matrix and the strictly lower triangular part of
+*>           A is not referenced.
+*>           Before entry with UPLO = 'L' or 'l', the leading n by n
+*>           lower triangular part of the array A must contain the lower
+*>           triangular matrix and the strictly upper triangular part of
+*>           A is not referenced.
+*>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*>           A are not referenced either, but are assumed to be unity.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is DOUBLE PRECISION array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the n
+*>           element right-hand side vector b. On exit, X is overwritten
+*>           with the solution vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*  =====================================================================
+      SUBROUTINE DTRSV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A(LDA,*),X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ZERO
+      PARAMETER (ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION TEMP
+      INTEGER I,INFO,IX,J,JX,KX
+      LOGICAL NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('DTRSV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x := inv( A )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          IF (NOUNIT) X(J) = X(J)/A(J,J)
+                          TEMP = X(J)
+                          DO 10 I = J - 1,1,-1
+                              X(I) = X(I) - TEMP*A(I,J)
+   10                     CONTINUE
+                      END IF
+   20             CONTINUE
+              ELSE
+                  JX = KX + (N-1)*INCX
+                  DO 40 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          IF (NOUNIT) X(JX) = X(JX)/A(J,J)
+                          TEMP = X(JX)
+                          IX = JX
+                          DO 30 I = J - 1,1,-1
+                              IX = IX - INCX
+                              X(IX) = X(IX) - TEMP*A(I,J)
+   30                     CONTINUE
+                      END IF
+                      JX = JX - INCX
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          IF (NOUNIT) X(J) = X(J)/A(J,J)
+                          TEMP = X(J)
+                          DO 50 I = J + 1,N
+                              X(I) = X(I) - TEMP*A(I,J)
+   50                     CONTINUE
+                      END IF
+   60             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 80 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          IF (NOUNIT) X(JX) = X(JX)/A(J,J)
+                          TEMP = X(JX)
+                          IX = JX
+                          DO 70 I = J + 1,N
+                              IX = IX + INCX
+                              X(IX) = X(IX) - TEMP*A(I,J)
+   70                     CONTINUE
+                      END IF
+                      JX = JX + INCX
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := inv( A**T )*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 100 J = 1,N
+                      TEMP = X(J)
+                      DO 90 I = 1,J - 1
+                          TEMP = TEMP - A(I,J)*X(I)
+   90                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/A(J,J)
+                      X(J) = TEMP
+  100             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 120 J = 1,N
+                      TEMP = X(JX)
+                      IX = KX
+                      DO 110 I = 1,J - 1
+                          TEMP = TEMP - A(I,J)*X(IX)
+                          IX = IX + INCX
+  110                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/A(J,J)
+                      X(JX) = TEMP
+                      JX = JX + INCX
+  120             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 140 J = N,1,-1
+                      TEMP = X(J)
+                      DO 130 I = N,J + 1,-1
+                          TEMP = TEMP - A(I,J)*X(I)
+  130                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/A(J,J)
+                      X(J) = TEMP
+  140             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 160 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = KX
+                      DO 150 I = N,J + 1,-1
+                          TEMP = TEMP - A(I,J)*X(IX)
+                          IX = IX - INCX
+  150                 CONTINUE
+                      IF (NOUNIT) TEMP = TEMP/A(J,J)
+                      X(JX) = TEMP
+                      JX = JX - INCX
+  160             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of DTRSV .
+*
+      END

lapack-netlib/BLAS/SRC/dzasum.f

@@ -0,0 +1,98 @@
+*> \brief \b DZASUM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16 ZX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    DZASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and
+*>    returns a single precision result.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16 ZX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION STEMP
+      INTEGER I,NINCX
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION DCABS1
+      EXTERNAL DCABS1
+*     ..
+      DZASUM = 0.0d0
+      STEMP = 0.0d0
+      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+         DO I = 1,N
+            STEMP = STEMP + DCABS1(ZX(I))
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         NINCX = N*INCX
+         DO I = 1,NINCX,INCX
+            STEMP = STEMP + DCABS1(ZX(I))
+         END DO
+      END IF
+      DZASUM = STEMP
+      RETURN
+      END

lapack-netlib/BLAS/SRC/dznrm2.f

@@ -0,0 +1,119 @@
+*> \brief \b DZNRM2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16 X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DZNRM2 returns the euclidean norm of a vector via the function
+*> name, so that
+*>
+*>    DZNRM2 := sqrt( x**H*x )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup double_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  -- This version written on 25-October-1982.
+*>     Modified on 14-October-1993 to inline the call to ZLASSQ.
+*>     Sven Hammarling, Nag Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION ONE,ZERO
+      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
+*     ..
+*     .. Local Scalars ..
+      DOUBLE PRECISION NORM,SCALE,SSQ,TEMP
+      INTEGER IX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,DBLE,DIMAG,SQRT
+*     ..
+      IF (N.LT.1 .OR. INCX.LT.1) THEN
+          NORM = ZERO
+      ELSE
+          SCALE = ZERO
+          SSQ = ONE
+*        The following loop is equivalent to this call to the LAPACK
+*        auxiliary routine:
+*        CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
+*
+          DO 10 IX = 1,1 + (N-1)*INCX,INCX
+              IF (DBLE(X(IX)).NE.ZERO) THEN
+                  TEMP = ABS(DBLE(X(IX)))
+                  IF (SCALE.LT.TEMP) THEN
+                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
+                      SCALE = TEMP
+                  ELSE
+                      SSQ = SSQ + (TEMP/SCALE)**2
+                  END IF
+              END IF
+              IF (DIMAG(X(IX)).NE.ZERO) THEN
+                  TEMP = ABS(DIMAG(X(IX)))
+                  IF (SCALE.LT.TEMP) THEN
+                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
+                      SCALE = TEMP
+                  ELSE
+                      SSQ = SSQ + (TEMP/SCALE)**2
+                  END IF
+              END IF
+   10     CONTINUE
+          NORM = SCALE*SQRT(SSQ)
+      END IF
+*
+      DZNRM2 = NORM
+      RETURN
+*
+*     End of DZNRM2.
+*
+      END

lapack-netlib/BLAS/SRC/icamax.f

@@ -0,0 +1,107 @@
+*> \brief \b ICAMAX
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       INTEGER FUNCTION ICAMAX(N,CX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX CX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    ICAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)|
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup aux_blas
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      INTEGER FUNCTION ICAMAX(N,CX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL SMAX
+      INTEGER I,IX
+*     ..
+*     .. External Functions ..
+      REAL SCABS1
+      EXTERNAL SCABS1
+*     ..
+      ICAMAX = 0
+      IF (N.LT.1 .OR. INCX.LE.0) RETURN
+      ICAMAX = 1
+      IF (N.EQ.1) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+         SMAX = SCABS1(CX(1))
+         DO I = 2,N
+            IF (SCABS1(CX(I)).GT.SMAX) THEN
+               ICAMAX = I
+               SMAX = SCABS1(CX(I))
+            END IF
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         IX = 1
+         SMAX = SCABS1(CX(1))
+         IX = IX + INCX
+         DO I = 2,N
+            IF (SCABS1(CX(IX)).GT.SMAX) THEN
+               ICAMAX = I
+               SMAX = SCABS1(CX(IX))
+            END IF
+            IX = IX + INCX
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/idamax.f

@@ -0,0 +1,106 @@
+*> \brief \b IDAMAX
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       INTEGER FUNCTION IDAMAX(N,DX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION DX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    IDAMAX finds the index of the first element having maximum absolute value.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup aux_blas
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      INTEGER FUNCTION IDAMAX(N,DX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION DX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DMAX
+      INTEGER I,IX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC DABS
+*     ..
+      IDAMAX = 0
+      IF (N.LT.1 .OR. INCX.LE.0) RETURN
+      IDAMAX = 1
+      IF (N.EQ.1) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+         DMAX = DABS(DX(1))
+         DO I = 2,N
+            IF (DABS(DX(I)).GT.DMAX) THEN
+               IDAMAX = I
+               DMAX = DABS(DX(I))
+            END IF
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         IX = 1
+         DMAX = DABS(DX(1))
+         IX = IX + INCX
+         DO I = 2,N
+            IF (DABS(DX(IX)).GT.DMAX) THEN
+               IDAMAX = I
+               DMAX = DABS(DX(IX))
+            END IF
+            IX = IX + INCX
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/isamax.f

@@ -0,0 +1,106 @@
+*> \brief \b ISAMAX
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       INTEGER FUNCTION ISAMAX(N,SX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    ISAMAX finds the index of the first element having maximum absolute value.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup aux_blas
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      INTEGER FUNCTION ISAMAX(N,SX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL SMAX
+      INTEGER I,IX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS
+*     ..
+      ISAMAX = 0
+      IF (N.LT.1 .OR. INCX.LE.0) RETURN
+      ISAMAX = 1
+      IF (N.EQ.1) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+         SMAX = ABS(SX(1))
+         DO I = 2,N
+            IF (ABS(SX(I)).GT.SMAX) THEN
+               ISAMAX = I
+               SMAX = ABS(SX(I))
+            END IF
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         IX = 1
+         SMAX = ABS(SX(1))
+         IX = IX + INCX
+         DO I = 2,N
+            IF (ABS(SX(IX)).GT.SMAX) THEN
+               ISAMAX = I
+               SMAX = ABS(SX(IX))
+            END IF
+            IX = IX + INCX
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/izamax.f

@@ -0,0 +1,107 @@
+*> \brief \b IZAMAX
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       INTEGER FUNCTION IZAMAX(N,ZX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16 ZX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    IZAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)|
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup aux_blas
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, 1/15/85.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      INTEGER FUNCTION IZAMAX(N,ZX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16 ZX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DMAX
+      INTEGER I,IX
+*     ..
+*     .. External Functions ..
+      DOUBLE PRECISION DCABS1
+      EXTERNAL DCABS1
+*     ..
+      IZAMAX = 0
+      IF (N.LT.1 .OR. INCX.LE.0) RETURN
+      IZAMAX = 1
+      IF (N.EQ.1) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+         DMAX = DCABS1(ZX(1))
+         DO I = 2,N
+            IF (DCABS1(ZX(I)).GT.DMAX) THEN
+               IZAMAX = I
+               DMAX = DCABS1(ZX(I))
+            END IF
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         IX = 1
+         DMAX = DCABS1(ZX(1))
+         IX = IX + INCX
+         DO I = 2,N
+            IF (DCABS1(ZX(IX)).GT.DMAX) THEN
+               IZAMAX = I
+               DMAX = DCABS1(ZX(IX))
+            END IF
+            IX = IX + INCX
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/lsame.f

@@ -0,0 +1,125 @@
+*> \brief \b LSAME
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       LOGICAL FUNCTION LSAME(CA,CB)
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER CA,CB
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> LSAME returns .TRUE. if CA is the same letter as CB regardless of
+*> case.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] CA
+*> \verbatim
+*>          CA is CHARACTER*1
+*> \endverbatim
+*>
+*> \param[in] CB
+*> \verbatim
+*>          CB is CHARACTER*1
+*>          CA and CB specify the single characters to be compared.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup aux_blas
+*
+*  =====================================================================
+      LOGICAL FUNCTION LSAME(CA,CB)
+*
+*  -- Reference BLAS level1 routine (version 3.1) --
+*  -- Reference BLAS 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 CA,CB
+*     ..
+*
+* =====================================================================
+*
+*     .. Intrinsic Functions ..
+      INTRINSIC ICHAR
+*     ..
+*     .. Local Scalars ..
+      INTEGER INTA,INTB,ZCODE
+*     ..
+*
+*     Test if the characters are equal
+*
+      LSAME = CA .EQ. CB
+      IF (LSAME) RETURN
+*
+*     Now test for equivalence if both characters are alphabetic.
+*
+      ZCODE = ICHAR('Z')
+*
+*     Use 'Z' rather than 'A' so that ASCII can be detected on Prime
+*     machines, on which ICHAR returns a value with bit 8 set.
+*     ICHAR('A') on Prime machines returns 193 which is the same as
+*     ICHAR('A') on an EBCDIC machine.
+*
+      INTA = ICHAR(CA)
+      INTB = ICHAR(CB)
+*
+      IF (ZCODE.EQ.90 .OR. ZCODE.EQ.122) THEN
+*
+*        ASCII is assumed - ZCODE is the ASCII code of either lower or
+*        upper case 'Z'.
+*
+          IF (INTA.GE.97 .AND. INTA.LE.122) INTA = INTA - 32
+          IF (INTB.GE.97 .AND. INTB.LE.122) INTB = INTB - 32
+*
+      ELSE IF (ZCODE.EQ.233 .OR. ZCODE.EQ.169) THEN
+*
+*        EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
+*        upper case 'Z'.
+*
+          IF (INTA.GE.129 .AND. INTA.LE.137 .OR.
+     +        INTA.GE.145 .AND. INTA.LE.153 .OR.
+     +        INTA.GE.162 .AND. INTA.LE.169) INTA = INTA + 64
+          IF (INTB.GE.129 .AND. INTB.LE.137 .OR.
+     +        INTB.GE.145 .AND. INTB.LE.153 .OR.
+     +        INTB.GE.162 .AND. INTB.LE.169) INTB = INTB + 64
+*
+      ELSE IF (ZCODE.EQ.218 .OR. ZCODE.EQ.250) THEN
+*
+*        ASCII is assumed, on Prime machines - ZCODE is the ASCII code
+*        plus 128 of either lower or upper case 'Z'.
+*
+          IF (INTA.GE.225 .AND. INTA.LE.250) INTA = INTA - 32
+          IF (INTB.GE.225 .AND. INTB.LE.250) INTB = INTB - 32
+      END IF
+      LSAME = INTA .EQ. INTB
+*
+*     RETURN
+*
+*     End of LSAME
+*
+      END

lapack-netlib/BLAS/SRC/sasum.f

@@ -0,0 +1,112 @@
+*> \brief \b SASUM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       REAL FUNCTION SASUM(N,SX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    SASUM takes the sum of the absolute values.
+*>    uses unrolled loops for increment equal to one.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      REAL FUNCTION SASUM(N,SX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ..
+      REAL SX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL STEMP
+      INTEGER I,M,MP1,NINCX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,MOD
+*     ..
+      SASUM = 0.0e0
+      STEMP = 0.0e0
+      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (INCX.EQ.1) THEN
+*        code for increment equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,6)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               STEMP = STEMP + ABS(SX(I))
+            END DO
+            IF (N.LT.6) THEN
+               SASUM = STEMP
+               RETURN
+            END IF
+         END IF
+         MP1 = M + 1
+         DO I = MP1,N,6
+            STEMP = STEMP + ABS(SX(I)) + ABS(SX(I+1)) +
+     $              ABS(SX(I+2)) + ABS(SX(I+3)) +
+     $              ABS(SX(I+4)) + ABS(SX(I+5))
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         NINCX = N*INCX
+         DO I = 1,NINCX,INCX
+            STEMP = STEMP + ABS(SX(I))
+         END DO
+      END IF
+      SASUM = STEMP
+      RETURN
+      END

lapack-netlib/BLAS/SRC/saxpy.f

@@ -0,0 +1,115 @@
+*> \brief \b SAXPY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       REAL SA
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SX(*),SY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    SAXPY constant times a vector plus a vector.
+*>    uses unrolled loops for increments equal to one.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 SA
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*),SY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,IX,IY,M,MP1
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      IF (N.LE.0) RETURN
+      IF (SA.EQ.0.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,4)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               SY(I) = SY(I) + SA*SX(I)
+            END DO
+         END IF
+         IF (N.LT.4) RETURN
+         MP1 = M + 1
+         DO I = MP1,N,4
+            SY(I) = SY(I) + SA*SX(I)
+            SY(I+1) = SY(I+1) + SA*SX(I+1)
+            SY(I+2) = SY(I+2) + SA*SX(I+2)
+            SY(I+3) = SY(I+3) + SA*SX(I+3)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+          SY(IY) = SY(IY) + SA*SX(IX)
+          IX = IX + INCX
+          IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/scabs1.f

@@ -0,0 +1,57 @@
+*> \brief \b SCABS1
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       REAL FUNCTION SCABS1(Z)
+* 
+*       .. Scalar Arguments ..
+*       COMPLEX Z
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SCABS1 computes |Re(.)| + |Im(.)| of a complex number
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup single_blas_level1
+*
+*  =====================================================================
+      REAL FUNCTION SCABS1(Z)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      COMPLEX Z
+*     ..
+*
+*  =====================================================================
+*
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,AIMAG,REAL
+*     ..
+      SCABS1 = ABS(REAL(Z)) + ABS(AIMAG(Z))
+      RETURN
+      END

lapack-netlib/BLAS/SRC/scasum.f

@@ -0,0 +1,97 @@
+*> \brief \b SCASUM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       REAL FUNCTION SCASUM(N,CX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX CX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    SCASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and
+*>    returns a single precision result.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      REAL FUNCTION SCASUM(N,CX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL STEMP
+      INTEGER I,NINCX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,AIMAG,REAL
+*     ..
+      SCASUM = 0.0e0
+      STEMP = 0.0e0
+      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+         DO I = 1,N
+            STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         NINCX = N*INCX
+         DO I = 1,NINCX,INCX
+            STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
+         END DO
+      END IF
+      SCASUM = STEMP
+      RETURN
+      END

lapack-netlib/BLAS/SRC/scnrm2.f

@@ -0,0 +1,119 @@
+*> \brief \b SCNRM2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       REAL FUNCTION SCNRM2(N,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SCNRM2 returns the euclidean norm of a vector via the function
+*> name, so that
+*>
+*>    SCNRM2 := sqrt( x**H*x )
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  -- This version written on 25-October-1982.
+*>     Modified on 14-October-1993 to inline the call to CLASSQ.
+*>     Sven Hammarling, Nag Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      REAL FUNCTION SCNRM2(N,X,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL NORM,SCALE,SSQ,TEMP
+      INTEGER IX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,AIMAG,REAL,SQRT
+*     ..
+      IF (N.LT.1 .OR. INCX.LT.1) THEN
+          NORM = ZERO
+      ELSE
+          SCALE = ZERO
+          SSQ = ONE
+*        The following loop is equivalent to this call to the LAPACK
+*        auxiliary routine:
+*        CALL CLASSQ( N, X, INCX, SCALE, SSQ )
+*
+          DO 10 IX = 1,1 + (N-1)*INCX,INCX
+              IF (REAL(X(IX)).NE.ZERO) THEN
+                  TEMP = ABS(REAL(X(IX)))
+                  IF (SCALE.LT.TEMP) THEN
+                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
+                      SCALE = TEMP
+                  ELSE
+                      SSQ = SSQ + (TEMP/SCALE)**2
+                  END IF
+              END IF
+              IF (AIMAG(X(IX)).NE.ZERO) THEN
+                  TEMP = ABS(AIMAG(X(IX)))
+                  IF (SCALE.LT.TEMP) THEN
+                      SSQ = ONE + SSQ* (SCALE/TEMP)**2
+                      SCALE = TEMP
+                  ELSE
+                      SSQ = SSQ + (TEMP/SCALE)**2
+                  END IF
+              END IF
+   10     CONTINUE
+          NORM = SCALE*SQRT(SSQ)
+      END IF
+*
+      SCNRM2 = NORM
+      RETURN
+*
+*     End of SCNRM2.
+*
+      END

lapack-netlib/BLAS/SRC/scopy.f

@@ -0,0 +1,115 @@
+*> \brief \b SCOPY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SCOPY(N,SX,INCX,SY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SX(*),SY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    SCOPY copies a vector, x, to a vector, y.
+*>    uses unrolled loops for increments equal to 1.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SCOPY(N,SX,INCX,SY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*),SY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,IX,IY,M,MP1
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,7)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               SY(I) = SX(I)
+            END DO
+            IF (N.LT.7) RETURN
+         END IF   
+         MP1 = M + 1
+         DO I = MP1,N,7
+            SY(I) = SX(I)
+            SY(I+1) = SX(I+1)
+            SY(I+2) = SX(I+2)
+            SY(I+3) = SX(I+3)
+            SY(I+4) = SX(I+4)
+            SY(I+5) = SX(I+5)
+            SY(I+6) = SX(I+6)
+         END DO
+      ELSE      
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            SY(IY) = SX(IX)
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/sdot.f

@@ -0,0 +1,117 @@
+*> \brief \b SDOT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       REAL FUNCTION SDOT(N,SX,INCX,SY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SX(*),SY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    SDOT forms the dot product of two vectors.
+*>    uses unrolled loops for increments equal to one.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      REAL FUNCTION SDOT(N,SX,INCX,SY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*),SY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL STEMP
+      INTEGER I,IX,IY,M,MP1
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      STEMP = 0.0e0
+      SDOT = 0.0e0
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,5)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               STEMP = STEMP + SX(I)*SY(I)
+            END DO
+            IF (N.LT.5) THEN
+               SDOT=STEMP
+            RETURN
+            END IF
+         END IF
+         MP1 = M + 1
+         DO I = MP1,N,5
+          STEMP = STEMP + SX(I)*SY(I) + SX(I+1)*SY(I+1) +
+     $            SX(I+2)*SY(I+2) + SX(I+3)*SY(I+3) + SX(I+4)*SY(I+4)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            STEMP = STEMP + SX(IX)*SY(IY)
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      SDOT = STEMP
+      RETURN
+      END

lapack-netlib/BLAS/SRC/sdsdot.f

@@ -0,0 +1,255 @@
+*> \brief \b SDSDOT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY)
+* 
+*       .. Scalar Arguments ..
+*       REAL SB
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SX(*),SY(*)
+*       ..
+*  
+*    PURPOSE
+*    =======
+*  
+*    Compute the inner product of two vectors with extended
+*    precision accumulation.
+*  
+*    Returns S.P. result with dot product accumulated in D.P.
+*    SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
+*    where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+*    defined in a similar way using INCY.
+*  
+*    AUTHOR
+*    ======
+*    Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
+*    Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
+*  
+*    ARGUMENTS 
+*    =========
+*  
+*    N      (input) INTEGER
+*           number of elements in input vector(s)
+*  
+*    SB     (input) REAL
+*           single precision scalar to be added to inner product
+*  
+*    SX     (input) REAL array, dimension (N)
+*           single precision vector with N elements
+*  
+*    INCX   (input) INTEGER
+*           storage spacing between elements of SX
+*  
+*    SY     (input) REAL array, dimension (N)
+*           single precision vector with N elements
+*  
+*    INCY   (input) INTEGER
+*           storage spacing between elements of SY
+*  
+*    SDSDOT (output) REAL
+*           single precision dot product (SB if N .LE. 0)
+*  
+*    Further Details
+*    ===============
+*  
+*    REFERENCES
+*  
+*    C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+*    Krogh, Basic linear algebra subprograms for Fortran
+*    usage, Algorithm No. 539, Transactions on Mathematical
+*    Software 5, 3 (September 1979), pp. 308-323.
+*  
+*    REVISION HISTORY  (YYMMDD)
+*        
+*    791001  DATE WRITTEN
+*    890531  Changed all specific intrinsics to generic.  (WRB)
+*    890831  Modified array declarations.  (WRB)
+*    890831  REVISION DATE from Version 3.2
+*    891214  Prologue converted to Version 4.0 format.  (BAB)
+*    920310  Corrected definition of LX in DESCRIPTION.  (WRB)
+*    920501  Reformatted the REFERENCES section.  (WRB)
+*    070118  Reformat to LAPACK coding style
+*  
+*    =====================================================================
+*  
+*       .. Local Scalars ..
+*       DOUBLE PRECISION DSDOT
+*       INTEGER I,KX,KY,NS
+*       ..
+*       .. Intrinsic Functions ..
+*       INTRINSIC DBLE
+*       ..
+*       DSDOT = SB
+*       IF (N.LE.0) THEN
+*          SDSDOT = DSDOT
+*          RETURN
+*       END IF   
+*       IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN
+*  
+*       Code for equal and positive increments.
+*  
+*          NS = N*INCX
+*          DO I = 1,NS,INCX
+*             DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
+*          END DO
+*       ELSE
+*  
+*       Code for unequal or nonpositive increments.
+*  
+*          KX = 1
+*          KY = 1
+*          IF (INCX.LT.0) KX = 1 + (1-N)*INCX
+*          IF (INCY.LT.0) KY = 1 + (1-N)*INCY
+*          DO I = 1,N
+*             DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
+*             KX = KX + INCX
+*             KY = KY + INCY
+*          END DO
+*       END IF
+*       SDSDOT = DSDOT
+*       RETURN
+*       END
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*  =====================================================================
+      REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 SB
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*),SY(*)
+*     ..
+*
+*  PURPOSE
+*  =======
+*
+*  Compute the inner product of two vectors with extended
+*  precision accumulation.
+*
+*  Returns S.P. result with dot product accumulated in D.P.
+*  SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
+*  where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+*  defined in a similar way using INCY.
+*
+*  AUTHOR
+*  ======
+*  Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
+*  Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
+*
+*  ARGUMENTS 
+*  =========
+*
+*  N      (input) INTEGER
+*         number of elements in input vector(s)
+*
+*  SB     (input) REAL
+*         single precision scalar to be added to inner product
+*
+*  SX     (input) REAL array, dimension (N)
+*         single precision vector with N elements
+*
+*  INCX   (input) INTEGER
+*         storage spacing between elements of SX
+*
+*  SY     (input) REAL array, dimension (N)
+*         single precision vector with N elements
+*
+*  INCY   (input) INTEGER
+*         storage spacing between elements of SY
+*
+*  SDSDOT (output) REAL
+*         single precision dot product (SB if N .LE. 0)
+*
+*  Further Details
+*  ===============
+*
+*  REFERENCES
+*
+*  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+*  Krogh, Basic linear algebra subprograms for Fortran
+*  usage, Algorithm No. 539, Transactions on Mathematical
+*  Software 5, 3 (September 1979), pp. 308-323.
+*
+*  REVISION HISTORY  (YYMMDD)
+*      
+*  791001  DATE WRITTEN
+*  890531  Changed all specific intrinsics to generic.  (WRB)
+*  890831  Modified array declarations.  (WRB)
+*  890831  REVISION DATE from Version 3.2
+*  891214  Prologue converted to Version 4.0 format.  (BAB)
+*  920310  Corrected definition of LX in DESCRIPTION.  (WRB)
+*  920501  Reformatted the REFERENCES section.  (WRB)
+*  070118  Reformat to LAPACK coding style
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      DOUBLE PRECISION DSDOT
+      INTEGER I,KX,KY,NS
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC DBLE
+*     ..
+      DSDOT = SB
+      IF (N.LE.0) THEN
+         SDSDOT = DSDOT
+         RETURN
+      END IF   
+      IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN
+*
+*     Code for equal and positive increments.
+*
+         NS = N*INCX
+         DO I = 1,NS,INCX
+            DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
+         END DO
+      ELSE
+*
+*     Code for unequal or nonpositive increments.
+*
+         KX = 1
+         KY = 1
+         IF (INCX.LT.0) KX = 1 + (1-N)*INCX
+         IF (INCY.LT.0) KY = 1 + (1-N)*INCY
+         DO I = 1,N
+            DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
+            KX = KX + INCX
+            KY = KY + INCY
+         END DO
+      END IF
+      SDSDOT = DSDOT
+      RETURN
+      END

lapack-netlib/BLAS/SRC/sgbmv.f

@@ -0,0 +1,370 @@
+*> \brief \b SGBMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       REAL ALPHA,BETA
+*       INTEGER INCX,INCY,KL,KU,LDA,M,N
+*       CHARACTER TRANS
+*       ..
+*       .. Array Arguments ..
+*       REAL A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SGBMV  performs one of the matrix-vector operations
+*>
+*>    y := alpha*A*x + beta*y,   or   y := alpha*A**T*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are vectors and A is an
+*> m by n band matrix, with kl sub-diagonals and ku super-diagonals.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*>
+*>              TRANS = 'T' or 't'   y := alpha*A**T*x + beta*y.
+*>
+*>              TRANS = 'C' or 'c'   y := alpha*A**T*x + beta*y.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] KL
+*> \verbatim
+*>          KL is INTEGER
+*>           On entry, KL specifies the number of sub-diagonals of the
+*>           matrix A. KL must satisfy  0 .le. KL.
+*> \endverbatim
+*>
+*> \param[in] KU
+*> \verbatim
+*>          KU is INTEGER
+*>           On entry, KU specifies the number of super-diagonals of the
+*>           matrix A. KU must satisfy  0 .le. KU.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading ( kl + ku + 1 ) by n part of the
+*>           array A must contain the matrix of coefficients, supplied
+*>           column by column, with the leading diagonal of the matrix in
+*>           row ( ku + 1 ) of the array, the first super-diagonal
+*>           starting at position 2 in row ku, the first sub-diagonal
+*>           starting at position 1 in row ( ku + 2 ), and so on.
+*>           Elements in the array A that do not correspond to elements
+*>           in the band matrix (such as the top left ku by ku triangle)
+*>           are not referenced.
+*>           The following program segment will transfer a band matrix
+*>           from conventional full matrix storage to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    K = KU + 1 - J
+*>                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
+*>                       A( K + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( kl + ku + 1 ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is REAL array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*>           Before entry, the incremented array X must contain the
+*>           vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is REAL
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is REAL array of DIMENSION at least
+*>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*>           Before entry, the incremented array Y must contain the
+*>           vector y. On exit, Y is overwritten by the updated vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup single_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      REAL ALPHA,BETA
+      INTEGER INCX,INCY,KL,KU,LDA,M,N
+      CHARACTER TRANS
+*     ..
+*     .. Array Arguments ..
+      REAL A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL TEMP
+      INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX,MIN
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +    .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 1
+      ELSE IF (M.LT.0) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (KL.LT.0) THEN
+          INFO = 4
+      ELSE IF (KU.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT. (KL+KU+1)) THEN
+          INFO = 8
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 10
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 13
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('SGBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          LENX = N
+          LENY = M
+      ELSE
+          LENX = M
+          LENY = N
+      END IF
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (LENX-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (LENY-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through the band part of A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,LENY
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,LENY
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,LENY
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,LENY
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      KUP1 = KU + 1
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+          JX = KX
+          IF (INCY.EQ.1) THEN
+              DO 60 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  K = KUP1 - J
+                  DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
+                      Y(I) = Y(I) + TEMP*A(K+I,J)
+   50             CONTINUE
+                  JX = JX + INCX
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  IY = KY
+                  K = KUP1 - J
+                  DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
+                      Y(IY) = Y(IY) + TEMP*A(K+I,J)
+                      IY = IY + INCY
+   70             CONTINUE
+                  JX = JX + INCX
+                  IF (J.GT.KU) KY = KY + INCY
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y := alpha*A**T*x + y.
+*
+          JY = KY
+          IF (INCX.EQ.1) THEN
+              DO 100 J = 1,N
+                  TEMP = ZERO
+                  K = KUP1 - J
+                  DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
+                      TEMP = TEMP + A(K+I,J)*X(I)
+   90             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+  100         CONTINUE
+          ELSE
+              DO 120 J = 1,N
+                  TEMP = ZERO
+                  IX = KX
+                  K = KUP1 - J
+                  DO 110 I = MAX(1,J-KU),MIN(M,J+KL)
+                      TEMP = TEMP + A(K+I,J)*X(IX)
+                      IX = IX + INCX
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+                  IF (J.GT.KU) KX = KX + INCX
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of SGBMV .
+*
+      END

lapack-netlib/BLAS/SRC/sgemm.f

@@ -0,0 +1,384 @@
+*> \brief \b SGEMM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+* 
+*       .. Scalar Arguments ..
+*       REAL ALPHA,BETA
+*       INTEGER K,LDA,LDB,LDC,M,N
+*       CHARACTER TRANSA,TRANSB
+*       ..
+*       .. Array Arguments ..
+*       REAL A(LDA,*),B(LDB,*),C(LDC,*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SGEMM  performs one of the matrix-matrix operations
+*>
+*>    C := alpha*op( A )*op( B ) + beta*C,
+*>
+*> where  op( X ) is one of
+*>
+*>    op( X ) = X   or   op( X ) = X**T,
+*>
+*> alpha and beta are scalars, and A, B and C are matrices, with op( A )
+*> an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANSA
+*> \verbatim
+*>          TRANSA is CHARACTER*1
+*>           On entry, TRANSA specifies the form of op( A ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSA = 'N' or 'n',  op( A ) = A.
+*>
+*>              TRANSA = 'T' or 't',  op( A ) = A**T.
+*>
+*>              TRANSA = 'C' or 'c',  op( A ) = A**T.
+*> \endverbatim
+*>
+*> \param[in] TRANSB
+*> \verbatim
+*>          TRANSB is CHARACTER*1
+*>           On entry, TRANSB specifies the form of op( B ) to be used in
+*>           the matrix multiplication as follows:
+*>
+*>              TRANSB = 'N' or 'n',  op( B ) = B.
+*>
+*>              TRANSB = 'T' or 't',  op( B ) = B**T.
+*>
+*>              TRANSB = 'C' or 'c',  op( B ) = B**T.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry,  M  specifies  the number  of rows  of the  matrix
+*>           op( A )  and of the  matrix  C.  M  must  be at least  zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry,  N  specifies the number  of columns of the matrix
+*>           op( B ) and the number of columns of the matrix C. N must be
+*>           at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry,  K  specifies  the number of columns of the matrix
+*>           op( A ) and the number of rows of the matrix op( B ). K must
+*>           be at least  zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array of DIMENSION ( LDA, ka ), where ka is
+*>           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
+*>           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
+*>           part of the array  A  must contain the matrix  A,  otherwise
+*>           the leading  k by m  part of the array  A  must contain  the
+*>           matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
+*>           LDA must be at least  max( 1, m ), otherwise  LDA must be at
+*>           least  max( 1, k ).
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          B is REAL array of DIMENSION ( LDB, kb ), where kb is
+*>           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
+*>           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
+*>           part of the array  B  must contain the matrix  B,  otherwise
+*>           the leading  n by k  part of the array  B  must contain  the
+*>           matrix B.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>           On entry, LDB specifies the first dimension of B as declared
+*>           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
+*>           LDB must be at least  max( 1, k ), otherwise  LDB must be at
+*>           least  max( 1, n ).
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is REAL
+*>           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
+*>           supplied as zero then C need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array of DIMENSION ( LDC, n ).
+*>           Before entry, the leading  m by n  part of the array  C must
+*>           contain the matrix  C,  except when  beta  is zero, in which
+*>           case C need not be set on entry.
+*>           On exit, the array  C  is overwritten by the  m by n  matrix
+*>           ( alpha*op( A )*op( B ) + beta*C ).
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>           On entry, LDC specifies the first dimension of C as declared
+*>           in  the  calling  (sub)  program.   LDC  must  be  at  least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup single_blas_level3
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 3 Blas routine.
+*>
+*>  -- Written on 8-February-1989.
+*>     Jack Dongarra, Argonne National Laboratory.
+*>     Iain Duff, AERE Harwell.
+*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*>     Sven Hammarling, Numerical Algorithms Group Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
+*
+*  -- Reference BLAS level3 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      REAL ALPHA,BETA
+      INTEGER K,LDA,LDB,LDC,M,N
+      CHARACTER TRANSA,TRANSB
+*     ..
+*     .. Array Arguments ..
+      REAL A(LDA,*),B(LDB,*),C(LDC,*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      REAL TEMP
+      INTEGER I,INFO,J,L,NCOLA,NROWA,NROWB
+      LOGICAL NOTA,NOTB
+*     ..
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*
+*     Set  NOTA  and  NOTB  as  true if  A  and  B  respectively are not
+*     transposed and set  NROWA, NCOLA and  NROWB  as the number of rows
+*     and  columns of  A  and the  number of  rows  of  B  respectively.
+*
+      NOTA = LSAME(TRANSA,'N')
+      NOTB = LSAME(TRANSB,'N')
+      IF (NOTA) THEN
+          NROWA = M
+          NCOLA = K
+      ELSE
+          NROWA = K
+          NCOLA = M
+      END IF
+      IF (NOTB) THEN
+          NROWB = K
+      ELSE
+          NROWB = N
+      END IF
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND.
+     +    (.NOT.LSAME(TRANSA,'T'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND.
+     +         (.NOT.LSAME(TRANSB,'T'))) THEN
+          INFO = 2
+      ELSE IF (M.LT.0) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (K.LT.0) THEN
+          INFO = 5
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 8
+      ELSE IF (LDB.LT.MAX(1,NROWB)) THEN
+          INFO = 10
+      ELSE IF (LDC.LT.MAX(1,M)) THEN
+          INFO = 13
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('SGEMM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN
+*
+*     And if  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          IF (BETA.EQ.ZERO) THEN
+              DO 20 J = 1,N
+                  DO 10 I = 1,M
+                      C(I,J) = ZERO
+   10             CONTINUE
+   20         CONTINUE
+          ELSE
+              DO 40 J = 1,N
+                  DO 30 I = 1,M
+                      C(I,J) = BETA*C(I,J)
+   30             CONTINUE
+   40         CONTINUE
+          END IF
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (NOTB) THEN
+          IF (NOTA) THEN
+*
+*           Form  C := alpha*A*B + beta*C.
+*
+              DO 90 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 50 I = 1,M
+                          C(I,J) = ZERO
+   50                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 60 I = 1,M
+                          C(I,J) = BETA*C(I,J)
+   60                 CONTINUE
+                  END IF
+                  DO 80 L = 1,K
+                      TEMP = ALPHA*B(L,J)
+                      DO 70 I = 1,M
+                          C(I,J) = C(I,J) + TEMP*A(I,L)
+   70                 CONTINUE
+   80             CONTINUE
+   90         CONTINUE
+          ELSE
+*
+*           Form  C := alpha*A**T*B + beta*C
+*
+              DO 120 J = 1,N
+                  DO 110 I = 1,M
+                      TEMP = ZERO
+                      DO 100 L = 1,K
+                          TEMP = TEMP + A(L,I)*B(L,J)
+  100                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  110             CONTINUE
+  120         CONTINUE
+          END IF
+      ELSE
+          IF (NOTA) THEN
+*
+*           Form  C := alpha*A*B**T + beta*C
+*
+              DO 170 J = 1,N
+                  IF (BETA.EQ.ZERO) THEN
+                      DO 130 I = 1,M
+                          C(I,J) = ZERO
+  130                 CONTINUE
+                  ELSE IF (BETA.NE.ONE) THEN
+                      DO 140 I = 1,M
+                          C(I,J) = BETA*C(I,J)
+  140                 CONTINUE
+                  END IF
+                  DO 160 L = 1,K
+                      TEMP = ALPHA*B(J,L)
+                      DO 150 I = 1,M
+                          C(I,J) = C(I,J) + TEMP*A(I,L)
+  150                 CONTINUE
+  160             CONTINUE
+  170         CONTINUE
+          ELSE
+*
+*           Form  C := alpha*A**T*B**T + beta*C
+*
+              DO 200 J = 1,N
+                  DO 190 I = 1,M
+                      TEMP = ZERO
+                      DO 180 L = 1,K
+                          TEMP = TEMP + A(L,I)*B(J,L)
+  180                 CONTINUE
+                      IF (BETA.EQ.ZERO) THEN
+                          C(I,J) = ALPHA*TEMP
+                      ELSE
+                          C(I,J) = ALPHA*TEMP + BETA*C(I,J)
+                      END IF
+  190             CONTINUE
+  200         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of SGEMM .
+*
+      END

lapack-netlib/BLAS/SRC/sgemv.f

@@ -0,0 +1,330 @@
+*> \brief \b SGEMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       REAL ALPHA,BETA
+*       INTEGER INCX,INCY,LDA,M,N
+*       CHARACTER TRANS
+*       ..
+*       .. Array Arguments ..
+*       REAL A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SGEMV  performs one of the matrix-vector operations
+*>
+*>    y := alpha*A*x + beta*y,   or   y := alpha*A**T*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are vectors and A is an
+*> m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>           On entry, TRANS specifies the operation to be performed as
+*>           follows:
+*>
+*>              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
+*>
+*>              TRANS = 'T' or 't'   y := alpha*A**T*x + beta*y.
+*>
+*>              TRANS = 'C' or 'c'   y := alpha*A**T*x + beta*y.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading m by n part of the array A must
+*>           contain the matrix of coefficients.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, m ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is REAL array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+*>           Before entry, the incremented array X must contain the
+*>           vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is REAL
+*>           On entry, BETA specifies the scalar beta. When BETA is
+*>           supplied as zero then Y need not be set on input.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is REAL array of DIMENSION at least
+*>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+*>           and at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+*>           Before entry with BETA non-zero, the incremented array Y
+*>           must contain the vector y. On exit, Y is overwritten by the
+*>           updated vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2015
+*
+*> \ingroup single_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.6.0) --
+*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      REAL ALPHA,BETA
+      INTEGER INCX,INCY,LDA,M,N
+      CHARACTER TRANS
+*     ..
+*     .. Array Arguments ..
+      REAL A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL TEMP
+      INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +    .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 1
+      ELSE IF (M.LT.0) THEN
+          INFO = 2
+      ELSE IF (N.LT.0) THEN
+          INFO = 3
+      ELSE IF (LDA.LT.MAX(1,M)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('SGEMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
+     +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
+*     up the start points in  X  and  Y.
+*
+      IF (LSAME(TRANS,'N')) THEN
+          LENX = N
+          LENY = M
+      ELSE
+          LENX = M
+          LENY = N
+      END IF
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (LENX-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (LENY-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,LENY
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,LENY
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,LENY
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,LENY
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  y := alpha*A*x + y.
+*
+          JX = KX
+          IF (INCY.EQ.1) THEN
+              DO 60 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  DO 50 I = 1,M
+                      Y(I) = Y(I) + TEMP*A(I,J)
+   50             CONTINUE
+                  JX = JX + INCX
+   60         CONTINUE
+          ELSE
+              DO 80 J = 1,N
+                  TEMP = ALPHA*X(JX)
+                  IY = KY
+                  DO 70 I = 1,M
+                      Y(IY) = Y(IY) + TEMP*A(I,J)
+                      IY = IY + INCY
+   70             CONTINUE
+                  JX = JX + INCX
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y := alpha*A**T*x + y.
+*
+          JY = KY
+          IF (INCX.EQ.1) THEN
+              DO 100 J = 1,N
+                  TEMP = ZERO
+                  DO 90 I = 1,M
+                      TEMP = TEMP + A(I,J)*X(I)
+   90             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+  100         CONTINUE
+          ELSE
+              DO 120 J = 1,N
+                  TEMP = ZERO
+                  IX = KX
+                  DO 110 I = 1,M
+                      TEMP = TEMP + A(I,J)*X(IX)
+                      IX = IX + INCX
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP
+                  JY = JY + INCY
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of SGEMV .
+*
+      END

lapack-netlib/BLAS/SRC/sger.f

@@ -0,0 +1,227 @@
+*> \brief \b SGER
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+* 
+*       .. Scalar Arguments ..
+*       REAL ALPHA
+*       INTEGER INCX,INCY,LDA,M,N
+*       ..
+*       .. Array Arguments ..
+*       REAL A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SGER   performs the rank 1 operation
+*>
+*>    A := alpha*x*y**T + A,
+*>
+*> where alpha is a scalar, x is an m element vector, y is an n element
+*> vector and A is an m by n matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>           On entry, M specifies the number of rows of the matrix A.
+*>           M must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the number of columns of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is REAL array of dimension at least
+*>           ( 1 + ( m - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the m
+*>           element vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*>          Y is REAL array of dimension at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the n
+*>           element vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array of DIMENSION ( LDA, n ).
+*>           Before entry, the leading m by n part of the array A must
+*>           contain the matrix of coefficients. On exit, A is
+*>           overwritten by the updated matrix.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           max( 1, m ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA
+      INTEGER INCX,INCY,LDA,M,N
+*     ..
+*     .. Array Arguments ..
+      REAL A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL ZERO
+      PARAMETER (ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL TEMP
+      INTEGER I,INFO,IX,J,JY,KX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (M.LT.0) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 7
+      ELSE IF (LDA.LT.MAX(1,M)) THEN
+          INFO = 9
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('SGER  ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (INCY.GT.0) THEN
+          JY = 1
+      ELSE
+          JY = 1 - (N-1)*INCY
+      END IF
+      IF (INCX.EQ.1) THEN
+          DO 20 J = 1,N
+              IF (Y(JY).NE.ZERO) THEN
+                  TEMP = ALPHA*Y(JY)
+                  DO 10 I = 1,M
+                      A(I,J) = A(I,J) + X(I)*TEMP
+   10             CONTINUE
+              END IF
+              JY = JY + INCY
+   20     CONTINUE
+      ELSE
+          IF (INCX.GT.0) THEN
+              KX = 1
+          ELSE
+              KX = 1 - (M-1)*INCX
+          END IF
+          DO 40 J = 1,N
+              IF (Y(JY).NE.ZERO) THEN
+                  TEMP = ALPHA*Y(JY)
+                  IX = KX
+                  DO 30 I = 1,M
+                      A(I,J) = A(I,J) + X(IX)*TEMP
+                      IX = IX + INCX
+   30             CONTINUE
+              END IF
+              JY = JY + INCY
+   40     CONTINUE
+      END IF
+*
+      RETURN
+*
+*     End of SGER  .
+*
+      END

lapack-netlib/BLAS/SRC/snrm2.f

@@ -0,0 +1,112 @@
+*> \brief \b SNRM2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       REAL FUNCTION SNRM2(N,X,INCX)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       REAL X(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SNRM2 returns the euclidean norm of a vector via the function
+*> name, so that
+*>
+*>    SNRM2 := sqrt( x'*x ).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  -- This version written on 25-October-1982.
+*>     Modified on 14-October-1993 to inline the call to SLASSQ.
+*>     Sven Hammarling, Nag Ltd.
+*> \endverbatim
+*>
+*  =====================================================================
+      REAL FUNCTION SNRM2(N,X,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ..
+      REAL X(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL ABSXI,NORM,SCALE,SSQ
+      INTEGER IX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,SQRT
+*     ..
+      IF (N.LT.1 .OR. INCX.LT.1) THEN
+          NORM = ZERO
+      ELSE IF (N.EQ.1) THEN
+          NORM = ABS(X(1))
+      ELSE
+          SCALE = ZERO
+          SSQ = ONE
+*        The following loop is equivalent to this call to the LAPACK
+*        auxiliary routine:
+*        CALL SLASSQ( N, X, INCX, SCALE, SSQ )
+*
+          DO 10 IX = 1,1 + (N-1)*INCX,INCX
+              IF (X(IX).NE.ZERO) THEN
+                  ABSXI = ABS(X(IX))
+                  IF (SCALE.LT.ABSXI) THEN
+                      SSQ = ONE + SSQ* (SCALE/ABSXI)**2
+                      SCALE = ABSXI
+                  ELSE
+                      SSQ = SSQ + (ABSXI/SCALE)**2
+                  END IF
+              END IF
+   10     CONTINUE
+          NORM = SCALE*SQRT(SSQ)
+      END IF
+*
+      SNRM2 = NORM
+      RETURN
+*
+*     End of SNRM2.
+*
+      END

lapack-netlib/BLAS/SRC/srot.f

@@ -0,0 +1,101 @@
+*> \brief \b SROT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S)
+* 
+*       .. Scalar Arguments ..
+*       REAL C,S
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SX(*),SY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    applies a plane rotation.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 C,S
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*),SY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL STEMP
+      INTEGER I,IX,IY
+*     ..
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*       code for both increments equal to 1
+*
+         DO I = 1,N
+            STEMP = C*SX(I) + S*SY(I)
+            SY(I) = C*SY(I) - S*SX(I)
+            SX(I) = STEMP
+         END DO
+      ELSE
+*
+*       code for unequal increments or equal increments not equal
+*         to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            STEMP = C*SX(IX) + S*SY(IY)
+            SY(IY) = C*SY(IY) - S*SX(IX)
+            SX(IX) = STEMP
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/srotg.f

@@ -0,0 +1,86 @@
+*> \brief \b SROTG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SROTG(SA,SB,C,S)
+* 
+*       .. Scalar Arguments ..
+*       REAL C,S,SA,SB
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    SROTG construct givens plane rotation.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SROTG(SA,SB,C,S)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 C,S,SA,SB
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL R,ROE,SCALE,Z
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,SIGN,SQRT
+*     ..
+      ROE = SB
+      IF (ABS(SA).GT.ABS(SB)) ROE = SA
+      SCALE = ABS(SA) + ABS(SB)
+      IF (SCALE.EQ.0.0) THEN
+         C = 1.0
+         S = 0.0
+         R = 0.0
+         Z = 0.0
+      ELSE
+         R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2)
+         R = SIGN(1.0,ROE)*R
+         C = SA/R
+         S = SB/R
+         Z = 1.0
+         IF (ABS(SA).GT.ABS(SB)) Z = S
+         IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C
+      END IF
+      SA = R
+      SB = Z
+      RETURN
+      END

lapack-netlib/BLAS/SRC/srotm.f

@@ -0,0 +1,203 @@
+*> \brief \b SROTM
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INCX,INCY,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SPARAM(5),SX(*),SY(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
+*>
+*>    (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
+*>    (SX**T)
+*>
+*>    SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
+*>    LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
+*>    WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+*>
+*>    SFLAG=-1.E0     SFLAG=0.E0        SFLAG=1.E0     SFLAG=-2.E0
+*>
+*>      (SH11  SH12)    (1.E0  SH12)    (SH11  1.E0)    (1.E0  0.E0)
+*>    H=(          )    (          )    (          )    (          )
+*>      (SH21  SH22),   (SH21  1.E0),   (-1.E0 SH22),   (0.E0  1.E0).
+*>    SEE  SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
+*>
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>         number of elements in input vector(s)
+*> \endverbatim
+*>
+*> \param[in,out] SX
+*> \verbatim
+*>          SX is REAL array, dimension N
+*>         double precision vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>         storage spacing between elements of SX
+*> \endverbatim
+*>
+*> \param[in,out] SY
+*> \verbatim
+*>          SY is REAL array, dimension N
+*>         double precision vector with N elements
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>         storage spacing between elements of SY
+*> \endverbatim
+*>
+*> \param[in,out] SPARAM
+*> \verbatim
+*>          SPARAM is REAL array, dimension 5
+*>     SPARAM(1)=SFLAG
+*>     SPARAM(2)=SH11
+*>     SPARAM(3)=SH21
+*>     SPARAM(4)=SH12
+*>     SPARAM(5)=SH22
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*  =====================================================================
+      SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SPARAM(5),SX(*),SY(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO
+      INTEGER I,KX,KY,NSTEPS
+*     ..
+*     .. Data statements ..
+      DATA ZERO,TWO/0.E0,2.E0/
+*     ..
+*
+      SFLAG = SPARAM(1)
+      IF (N.LE.0 .OR. (SFLAG+TWO.EQ.ZERO)) RETURN
+      IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
+*
+         NSTEPS = N*INCX
+         IF (SFLAG.LT.ZERO) THEN
+            SH11 = SPARAM(2)
+            SH12 = SPARAM(4)
+            SH21 = SPARAM(3)
+            SH22 = SPARAM(5)
+            DO I = 1,NSTEPS,INCX
+               W = SX(I)
+               Z = SY(I)
+               SX(I) = W*SH11 + Z*SH12
+               SY(I) = W*SH21 + Z*SH22
+            END DO
+         ELSE IF (SFLAG.EQ.ZERO) THEN
+            SH12 = SPARAM(4)
+            SH21 = SPARAM(3)
+            DO I = 1,NSTEPS,INCX
+               W = SX(I)
+               Z = SY(I)
+               SX(I) = W + Z*SH12
+               SY(I) = W*SH21 + Z
+            END DO
+         ELSE
+            SH11 = SPARAM(2)
+            SH22 = SPARAM(5)
+            DO I = 1,NSTEPS,INCX
+               W = SX(I)
+               Z = SY(I)
+               SX(I) = W*SH11 + Z
+               SY(I) = -W + SH22*Z
+            END DO
+         END IF
+      ELSE
+         KX = 1
+         KY = 1
+         IF (INCX.LT.0) KX = 1 + (1-N)*INCX
+         IF (INCY.LT.0) KY = 1 + (1-N)*INCY
+*
+         IF (SFLAG.LT.ZERO) THEN
+            SH11 = SPARAM(2)
+            SH12 = SPARAM(4)
+            SH21 = SPARAM(3)
+            SH22 = SPARAM(5)
+            DO I = 1,N
+               W = SX(KX)
+               Z = SY(KY)
+               SX(KX) = W*SH11 + Z*SH12
+               SY(KY) = W*SH21 + Z*SH22
+               KX = KX + INCX
+               KY = KY + INCY
+            END DO
+         ELSE IF (SFLAG.EQ.ZERO) THEN
+            SH12 = SPARAM(4)
+            SH21 = SPARAM(3)
+            DO I = 1,N
+               W = SX(KX)
+               Z = SY(KY)
+               SX(KX) = W + Z*SH12
+               SY(KY) = W*SH21 + Z
+               KX = KX + INCX
+               KY = KY + INCY
+            END DO
+         ELSE
+             SH11 = SPARAM(2)
+             SH22 = SPARAM(5)
+             DO I = 1,N
+                W = SX(KX)
+                Z = SY(KY)
+                SX(KX) = W*SH11 + Z
+                SY(KY) = -W + SH22*Z
+                KX = KX + INCX
+                KY = KY + INCY
+            END DO
+         END IF
+      END IF
+      RETURN
+      END

lapack-netlib/BLAS/SRC/srotmg.f

@@ -0,0 +1,251 @@
+*> \brief \b SROTMG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM)
+* 
+*       .. Scalar Arguments ..
+*       REAL SD1,SD2,SX1,SY1
+*       ..
+*       .. Array Arguments ..
+*       REAL SPARAM(5)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
+*>    THE SECOND COMPONENT OF THE 2-VECTOR  (SQRT(SD1)*SX1,SQRT(SD2)*>    SY2)**T.
+*>    WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
+*>
+*>    SFLAG=-1.E0     SFLAG=0.E0        SFLAG=1.E0     SFLAG=-2.E0
+*>
+*>      (SH11  SH12)    (1.E0  SH12)    (SH11  1.E0)    (1.E0  0.E0)
+*>    H=(          )    (          )    (          )    (          )
+*>      (SH21  SH22),   (SH21  1.E0),   (-1.E0 SH22),   (0.E0  1.E0).
+*>    LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22
+*>    RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE
+*>    VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.)
+*>
+*>    THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
+*>    INEXACT.  THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
+*>    OF SD1 AND SD2.  ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
+*>
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in,out] SD1
+*> \verbatim
+*>          SD1 is REAL
+*> \endverbatim
+*>
+*> \param[in,out] SD2
+*> \verbatim
+*>          SD2 is REAL
+*> \endverbatim
+*>
+*> \param[in,out] SX1
+*> \verbatim
+*>          SX1 is REAL
+*> \endverbatim
+*>
+*> \param[in] SY1
+*> \verbatim
+*>          SY1 is REAL
+*> \endverbatim
+*>
+*> \param[in,out] SPARAM
+*> \verbatim
+*>          SPARAM is REAL array, dimension 5
+*>     SPARAM(1)=SFLAG
+*>     SPARAM(2)=SH11
+*>     SPARAM(3)=SH21
+*>     SPARAM(4)=SH12
+*>     SPARAM(5)=SH22
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*  =====================================================================
+      SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 SD1,SD2,SX1,SY1
+*     ..
+*     .. Array Arguments ..
+      REAL SPARAM(5)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL GAM,GAMSQ,ONE,RGAMSQ,SFLAG,SH11,SH12,SH21,SH22,SP1,SP2,SQ1,
+     $     SQ2,STEMP,SU,TWO,ZERO
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS
+*     ..
+*     .. Data statements ..
+*
+      DATA ZERO,ONE,TWO/0.E0,1.E0,2.E0/
+      DATA GAM,GAMSQ,RGAMSQ/4096.E0,1.67772E7,5.96046E-8/
+*     ..
+
+      IF (SD1.LT.ZERO) THEN
+*        GO ZERO-H-D-AND-SX1..
+         SFLAG = -ONE
+         SH11 = ZERO
+         SH12 = ZERO
+         SH21 = ZERO
+         SH22 = ZERO
+*
+         SD1 = ZERO
+         SD2 = ZERO
+         SX1 = ZERO
+      ELSE
+*        CASE-SD1-NONNEGATIVE
+         SP2 = SD2*SY1
+         IF (SP2.EQ.ZERO) THEN
+            SFLAG = -TWO
+            SPARAM(1) = SFLAG
+            RETURN
+         END IF 
+*        REGULAR-CASE..
+         SP1 = SD1*SX1
+         SQ2 = SP2*SY1
+         SQ1 = SP1*SX1
+*
+         IF (ABS(SQ1).GT.ABS(SQ2)) THEN
+            SH21 = -SY1/SX1
+            SH12 = SP2/SP1
+*
+            SU = ONE - SH12*SH21
+*
+           IF (SU.GT.ZERO) THEN
+             SFLAG = ZERO
+             SD1 = SD1/SU
+             SD2 = SD2/SU
+             SX1 = SX1*SU
+           END IF
+         ELSE
+
+            IF (SQ2.LT.ZERO) THEN
+*              GO ZERO-H-D-AND-SX1..
+               SFLAG = -ONE
+               SH11 = ZERO
+               SH12 = ZERO
+               SH21 = ZERO
+               SH22 = ZERO
+*
+               SD1 = ZERO
+               SD2 = ZERO
+               SX1 = ZERO
+            ELSE
+               SFLAG = ONE
+               SH11 = SP1/SP2
+               SH22 = SX1/SY1
+               SU = ONE + SH11*SH22
+               STEMP = SD2/SU
+               SD2 = SD1/SU
+               SD1 = STEMP
+               SX1 = SY1*SU
+            END IF
+         END IF
+
+*     PROCESURE..SCALE-CHECK
+         IF (SD1.NE.ZERO) THEN
+            DO WHILE ((SD1.LE.RGAMSQ) .OR. (SD1.GE.GAMSQ))
+               IF (SFLAG.EQ.ZERO) THEN
+                  SH11 = ONE
+                  SH22 = ONE
+                  SFLAG = -ONE
+               ELSE
+                  SH21 = -ONE
+                  SH12 = ONE
+                  SFLAG = -ONE
+               END IF
+               IF (SD1.LE.RGAMSQ) THEN
+                  SD1 = SD1*GAM**2
+                  SX1 = SX1/GAM
+                  SH11 = SH11/GAM
+                  SH12 = SH12/GAM
+               ELSE
+                  SD1 = SD1/GAM**2
+                  SX1 = SX1*GAM
+                  SH11 = SH11*GAM
+                  SH12 = SH12*GAM
+               END IF
+            ENDDO
+         END IF
+  
+         IF (SD2.NE.ZERO) THEN
+            DO WHILE ( (ABS(SD2).LE.RGAMSQ) .OR. (ABS(SD2).GE.GAMSQ) )
+               IF (SFLAG.EQ.ZERO) THEN
+                  SH11 = ONE
+                  SH22 = ONE
+                  SFLAG = -ONE
+               ELSE
+                  SH21 = -ONE
+                  SH12 = ONE
+                  SFLAG = -ONE
+               END IF
+               IF (ABS(SD2).LE.RGAMSQ) THEN
+                  SD2 = SD2*GAM**2
+                  SH21 = SH21/GAM
+                  SH22 = SH22/GAM
+               ELSE
+                  SD2 = SD2/GAM**2
+                  SH21 = SH21*GAM
+                  SH22 = SH22*GAM
+               END IF      
+            END DO
+         END IF
+     
+      END IF
+
+      IF (SFLAG.LT.ZERO) THEN
+         SPARAM(2) = SH11
+         SPARAM(3) = SH21
+         SPARAM(4) = SH12
+         SPARAM(5) = SH22
+      ELSE IF (SFLAG.EQ.ZERO) THEN
+         SPARAM(3) = SH21
+         SPARAM(4) = SH12 
+      ELSE
+         SPARAM(2) = SH11
+         SPARAM(5) = SH22
+      END IF
+
+      SPARAM(1) = SFLAG
+      RETURN
+      END
+      
+     
+     
+     

lapack-netlib/BLAS/SRC/ssbmv.f

@@ -0,0 +1,375 @@
+*> \brief \b SSBMV
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+* 
+*       .. Scalar Arguments ..
+*       REAL ALPHA,BETA
+*       INTEGER INCX,INCY,K,LDA,N
+*       CHARACTER UPLO
+*       ..
+*       .. Array Arguments ..
+*       REAL A(LDA,*),X(*),Y(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SSBMV  performs the matrix-vector  operation
+*>
+*>    y := alpha*A*x + beta*y,
+*>
+*> where alpha and beta are scalars, x and y are n element vectors and
+*> A is an n by n symmetric band matrix, with k super-diagonals.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>           On entry, UPLO specifies whether the upper or lower
+*>           triangular part of the band matrix A is being supplied as
+*>           follows:
+*>
+*>              UPLO = 'U' or 'u'   The upper triangular part of A is
+*>                                  being supplied.
+*>
+*>              UPLO = 'L' or 'l'   The lower triangular part of A is
+*>                                  being supplied.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>           On entry, N specifies the order of the matrix A.
+*>           N must be at least zero.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>           On entry, K specifies the number of super-diagonals of the
+*>           matrix A. K must satisfy  0 .le. K.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>           On entry, ALPHA specifies the scalar alpha.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array of DIMENSION ( LDA, n ).
+*>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
+*>           by n part of the array A must contain the upper triangular
+*>           band part of the symmetric matrix, supplied column by
+*>           column, with the leading diagonal of the matrix in row
+*>           ( k + 1 ) of the array, the first super-diagonal starting at
+*>           position 2 in row k, and so on. The top left k by k triangle
+*>           of the array A is not referenced.
+*>           The following program segment will transfer the upper
+*>           triangular part of a symmetric band matrix from conventional
+*>           full matrix storage to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = K + 1 - J
+*>                    DO 10, I = MAX( 1, J - K ), J
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*>
+*>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
+*>           by n part of the array A must contain the lower triangular
+*>           band part of the symmetric matrix, supplied column by
+*>           column, with the leading diagonal of the matrix in row 1 of
+*>           the array, the first sub-diagonal starting at position 1 in
+*>           row 2, and so on. The bottom right k by k triangle of the
+*>           array A is not referenced.
+*>           The following program segment will transfer the lower
+*>           triangular part of a symmetric band matrix from conventional
+*>           full matrix storage to band storage:
+*>
+*>                 DO 20, J = 1, N
+*>                    M = 1 - J
+*>                    DO 10, I = J, MIN( N, J + K )
+*>                       A( M + I, J ) = matrix( I, J )
+*>              10    CONTINUE
+*>              20 CONTINUE
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>           On entry, LDA specifies the first dimension of A as declared
+*>           in the calling (sub) program. LDA must be at least
+*>           ( k + 1 ).
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is REAL array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCX ) ).
+*>           Before entry, the incremented array X must contain the
+*>           vector x.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>           On entry, INCX specifies the increment for the elements of
+*>           X. INCX must not be zero.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is REAL
+*>           On entry, BETA specifies the scalar beta.
+*> \endverbatim
+*>
+*> \param[in,out] Y
+*> \verbatim
+*>          Y is REAL array of DIMENSION at least
+*>           ( 1 + ( n - 1 )*abs( INCY ) ).
+*>           Before entry, the incremented array Y must contain the
+*>           vector y. On exit, Y is overwritten by the updated vector y.
+*> \endverbatim
+*>
+*> \param[in] INCY
+*> \verbatim
+*>          INCY is INTEGER
+*>           On entry, INCY specifies the increment for the elements of
+*>           Y. INCY must not be zero.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level2
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  Level 2 Blas routine.
+*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*>
+*>  -- Written on 22-October-1986.
+*>     Jack Dongarra, Argonne National Lab.
+*>     Jeremy Du Croz, Nag Central Office.
+*>     Sven Hammarling, Nag Central Office.
+*>     Richard Hanson, Sandia National Labs.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SSBMV(UPLO,N,K,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
+*
+*  -- Reference BLAS level2 routine (version 3.4.0) --
+*  -- Reference BLAS 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 ALPHA,BETA
+      INTEGER INCX,INCY,K,LDA,N
+      CHARACTER UPLO
+*     ..
+*     .. Array Arguments ..
+      REAL A(LDA,*),X(*),Y(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL TEMP1,TEMP2
+      INTEGER I,INFO,IX,IY,J,JX,JY,KPLUS1,KX,KY,L
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX,MIN
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (K.LT.0) THEN
+          INFO = 3
+      ELSE IF (LDA.LT. (K+1)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      ELSE IF (INCY.EQ.0) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('SSBMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
+*
+*     Set up the start points in  X  and  Y.
+*
+      IF (INCX.GT.0) THEN
+          KX = 1
+      ELSE
+          KX = 1 - (N-1)*INCX
+      END IF
+      IF (INCY.GT.0) THEN
+          KY = 1
+      ELSE
+          KY = 1 - (N-1)*INCY
+      END IF
+*
+*     Start the operations. In this version the elements of the array A
+*     are accessed sequentially with one pass through A.
+*
+*     First form  y := beta*y.
+*
+      IF (BETA.NE.ONE) THEN
+          IF (INCY.EQ.1) THEN
+              IF (BETA.EQ.ZERO) THEN
+                  DO 10 I = 1,N
+                      Y(I) = ZERO
+   10             CONTINUE
+              ELSE
+                  DO 20 I = 1,N
+                      Y(I) = BETA*Y(I)
+   20             CONTINUE
+              END IF
+          ELSE
+              IY = KY
+              IF (BETA.EQ.ZERO) THEN
+                  DO 30 I = 1,N
+                      Y(IY) = ZERO
+                      IY = IY + INCY
+   30             CONTINUE
+              ELSE
+                  DO 40 I = 1,N
+                      Y(IY) = BETA*Y(IY)
+                      IY = IY + INCY
+   40             CONTINUE
+              END IF
+          END IF
+      END IF
+      IF (ALPHA.EQ.ZERO) RETURN
+      IF (LSAME(UPLO,'U')) THEN
+*
+*        Form  y  when upper triangle of A is stored.
+*
+          KPLUS1 = K + 1
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 60 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  L = KPLUS1 - J
+                  DO 50 I = MAX(1,J-K),J - 1
+                      Y(I) = Y(I) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + A(L+I,J)*X(I)
+   50             CONTINUE
+                  Y(J) = Y(J) + TEMP1*A(KPLUS1,J) + ALPHA*TEMP2
+   60         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 80 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  IX = KX
+                  IY = KY
+                  L = KPLUS1 - J
+                  DO 70 I = MAX(1,J-K),J - 1
+                      Y(IY) = Y(IY) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + A(L+I,J)*X(IX)
+                      IX = IX + INCX
+                      IY = IY + INCY
+   70             CONTINUE
+                  Y(JY) = Y(JY) + TEMP1*A(KPLUS1,J) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+                  IF (J.GT.K) THEN
+                      KX = KX + INCX
+                      KY = KY + INCY
+                  END IF
+   80         CONTINUE
+          END IF
+      ELSE
+*
+*        Form  y  when lower triangle of A is stored.
+*
+          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
+              DO 100 J = 1,N
+                  TEMP1 = ALPHA*X(J)
+                  TEMP2 = ZERO
+                  Y(J) = Y(J) + TEMP1*A(1,J)
+                  L = 1 - J
+                  DO 90 I = J + 1,MIN(N,J+K)
+                      Y(I) = Y(I) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + A(L+I,J)*X(I)
+   90             CONTINUE
+                  Y(J) = Y(J) + ALPHA*TEMP2
+  100         CONTINUE
+          ELSE
+              JX = KX
+              JY = KY
+              DO 120 J = 1,N
+                  TEMP1 = ALPHA*X(JX)
+                  TEMP2 = ZERO
+                  Y(JY) = Y(JY) + TEMP1*A(1,J)
+                  L = 1 - J
+                  IX = JX
+                  IY = JY
+                  DO 110 I = J + 1,MIN(N,J+K)
+                      IX = IX + INCX
+                      IY = IY + INCY
+                      Y(IY) = Y(IY) + TEMP1*A(L+I,J)
+                      TEMP2 = TEMP2 + A(L+I,J)*X(IX)
+  110             CONTINUE
+                  Y(JY) = Y(JY) + ALPHA*TEMP2
+                  JX = JX + INCX
+                  JY = JY + INCY
+  120         CONTINUE
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of SSBMV .
+*
+      END

lapack-netlib/BLAS/SRC/sscal.f

@@ -0,0 +1,110 @@
+*> \brief \b SSCAL
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SSCAL(N,SA,SX,INCX)
+* 
+*       .. Scalar Arguments ..
+*       REAL SA
+*       INTEGER INCX,N
+*       ..
+*       .. Array Arguments ..
+*       REAL SX(*)
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*>    scales a vector by a constant.
+*>    uses unrolled loops for increment equal to 1.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup single_blas_level1
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>     jack dongarra, linpack, 3/11/78.
+*>     modified 3/93 to return if incx .le. 0.
+*>     modified 12/3/93, array(1) declarations changed to array(*)
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SSCAL(N,SA,SX,INCX)
+*
+*  -- Reference BLAS level1 routine (version 3.4.0) --
+*  -- Reference BLAS 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 SA
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*)
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,M,MP1,NINCX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      IF (N.LE.0 .OR. INCX.LE.0) RETURN
+      IF (INCX.EQ.1) THEN
+*
+*        code for increment equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,5)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               SX(I) = SA*SX(I)
+            END DO
+            IF (N.LT.5) RETURN
+         END IF
+         MP1 = M + 1
+         DO I = MP1,N,5
+            SX(I) = SA*SX(I)
+            SX(I+1) = SA*SX(I+1)
+            SX(I+2) = SA*SX(I+2)
+            SX(I+3) = SA*SX(I+3)
+            SX(I+4) = SA*SX(I+4)
+         END DO
+      ELSE
+*
+*        code for increment not equal to 1
+*
+         NINCX = N*INCX
+         DO I = 1,NINCX,INCX
+            SX(I) = SA*SX(I)
+         END DO
+      END IF
+      RETURN
+      END