1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191 |
- /* blas/blas.c
- *
- * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 Gerard Jungman & Brian
- * Gough
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 3 of the License, or (at
- * your option) any later version.
- *
- * This program is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
- */
- /* GSL implementation of BLAS operations for vectors and dense
- * matrices. Note that GSL native storage is row-major. */
- #include "gsl__config.h"
- #include "gsl_math.h"
- #include "gsl_errno.h"
- #include "gsl_cblas.h"
- #include "gsl_cblas.h"
- #include "gsl_blas_types.h"
- #include "gsl_blas.h"
- /* ========================================================================
- * Level 1
- * ========================================================================
- */
- /* CBLAS defines vector sizes in terms of int. GSL defines sizes in
- terms of size_t, so we need to convert these into integers. There
- is the possibility of overflow here. FIXME: Maybe this could be
- caught */
- #define INT(X) ((int)(X))
- int
- gsl_blas_sdsdot (float alpha, const gsl_vector_float * X,
- const gsl_vector_float * Y, float *result)
- {
- if (X->size == Y->size)
- {
- *result =
- cblas_sdsdot (INT (X->size), alpha, X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_dsdot (const gsl_vector_float * X, const gsl_vector_float * Y,
- double *result)
- {
- if (X->size == Y->size)
- {
- *result =
- cblas_dsdot (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_sdot (const gsl_vector_float * X, const gsl_vector_float * Y,
- float *result)
- {
- if (X->size == Y->size)
- {
- *result =
- cblas_sdot (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_ddot (const gsl_vector * X, const gsl_vector * Y, double *result)
- {
- if (X->size == Y->size)
- {
- *result =
- cblas_ddot (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_cdotu (const gsl_vector_complex_float * X,
- const gsl_vector_complex_float * Y, gsl_complex_float * dotu)
- {
- if (X->size == Y->size)
- {
- cblas_cdotu_sub (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride), GSL_COMPLEX_P (dotu));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_cdotc (const gsl_vector_complex_float * X,
- const gsl_vector_complex_float * Y, gsl_complex_float * dotc)
- {
- if (X->size == Y->size)
- {
- cblas_cdotc_sub (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride), GSL_COMPLEX_P (dotc));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zdotu (const gsl_vector_complex * X, const gsl_vector_complex * Y,
- gsl_complex * dotu)
- {
- if (X->size == Y->size)
- {
- cblas_zdotu_sub (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride), GSL_COMPLEX_P (dotu));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zdotc (const gsl_vector_complex * X, const gsl_vector_complex * Y,
- gsl_complex * dotc)
- {
- if (X->size == Y->size)
- {
- cblas_zdotc_sub (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride), GSL_COMPLEX_P (dotc));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* Norms of vectors */
- float
- gsl_blas_snrm2 (const gsl_vector_float * X)
- {
- return cblas_snrm2 (INT (X->size), X->data, INT (X->stride));
- }
- double
- gsl_blas_dnrm2 (const gsl_vector * X)
- {
- return cblas_dnrm2 (INT (X->size), X->data, INT (X->stride));
- }
- float
- gsl_blas_scnrm2 (const gsl_vector_complex_float * X)
- {
- return cblas_scnrm2 (INT (X->size), X->data, INT (X->stride));
- }
- double
- gsl_blas_dznrm2 (const gsl_vector_complex * X)
- {
- return cblas_dznrm2 (INT (X->size), X->data, INT (X->stride));
- }
- /* Absolute sums of vectors */
- float
- gsl_blas_sasum (const gsl_vector_float * X)
- {
- return cblas_sasum (INT (X->size), X->data, INT (X->stride));
- }
- double
- gsl_blas_dasum (const gsl_vector * X)
- {
- return cblas_dasum (INT (X->size), X->data, INT (X->stride));
- }
- float
- gsl_blas_scasum (const gsl_vector_complex_float * X)
- {
- return cblas_scasum (INT (X->size), X->data, INT (X->stride));
- }
- double
- gsl_blas_dzasum (const gsl_vector_complex * X)
- {
- return cblas_dzasum (INT (X->size), X->data, INT (X->stride));
- }
- /* Maximum elements of vectors */
- CBLAS_INDEX_t
- gsl_blas_isamax (const gsl_vector_float * X)
- {
- return cblas_isamax (INT (X->size), X->data, INT (X->stride));
- }
- CBLAS_INDEX_t
- gsl_blas_idamax (const gsl_vector * X)
- {
- return cblas_idamax (INT (X->size), X->data, INT (X->stride));
- }
- CBLAS_INDEX_t
- gsl_blas_icamax (const gsl_vector_complex_float * X)
- {
- return cblas_icamax (INT (X->size), X->data, INT (X->stride));
- }
- CBLAS_INDEX_t
- gsl_blas_izamax (const gsl_vector_complex * X)
- {
- return cblas_izamax (INT (X->size), X->data, INT (X->stride));
- }
- /* Swap vectors */
- int
- gsl_blas_sswap (gsl_vector_float * X, gsl_vector_float * Y)
- {
- if (X->size == Y->size)
- {
- cblas_sswap (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_dswap (gsl_vector * X, gsl_vector * Y)
- {
- if (X->size == Y->size)
- {
- cblas_dswap (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- };
- }
- int
- gsl_blas_cswap (gsl_vector_complex_float * X, gsl_vector_complex_float * Y)
- {
- if (X->size == Y->size)
- {
- cblas_cswap (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zswap (gsl_vector_complex * X, gsl_vector_complex * Y)
- {
- if (X->size == Y->size)
- {
- cblas_zswap (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* Copy vectors */
- int
- gsl_blas_scopy (const gsl_vector_float * X, gsl_vector_float * Y)
- {
- if (X->size == Y->size)
- {
- cblas_scopy (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_dcopy (const gsl_vector * X, gsl_vector * Y)
- {
- if (X->size == Y->size)
- {
- cblas_dcopy (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_ccopy (const gsl_vector_complex_float * X,
- gsl_vector_complex_float * Y)
- {
- if (X->size == Y->size)
- {
- cblas_ccopy (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zcopy (const gsl_vector_complex * X, gsl_vector_complex * Y)
- {
- if (X->size == Y->size)
- {
- cblas_zcopy (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* Compute Y = alpha X + Y */
- int
- gsl_blas_saxpy (float alpha, const gsl_vector_float * X, gsl_vector_float * Y)
- {
- if (X->size == Y->size)
- {
- cblas_saxpy (INT (X->size), alpha, X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_daxpy (double alpha, const gsl_vector * X, gsl_vector * Y)
- {
- if (X->size == Y->size)
- {
- cblas_daxpy (INT (X->size), alpha, X->data, INT (X->stride), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_caxpy (const gsl_complex_float alpha,
- const gsl_vector_complex_float * X,
- gsl_vector_complex_float * Y)
- {
- if (X->size == Y->size)
- {
- cblas_caxpy (INT (X->size), GSL_COMPLEX_P (&alpha), X->data,
- INT (X->stride), Y->data, INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zaxpy (const gsl_complex alpha, const gsl_vector_complex * X,
- gsl_vector_complex * Y)
- {
- if (X->size == Y->size)
- {
- cblas_zaxpy (INT (X->size), GSL_COMPLEX_P (&alpha), X->data,
- INT (X->stride), Y->data, INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* Generate rotation */
- int
- gsl_blas_srotg (float a[], float b[], float c[], float s[])
- {
- cblas_srotg (a, b, c, s);
- return GSL_SUCCESS;
- }
- int
- gsl_blas_drotg (double a[], double b[], double c[], double s[])
- {
- cblas_drotg (a, b, c, s);
- return GSL_SUCCESS;
- }
- /* Apply rotation to vectors */
- int
- gsl_blas_srot (gsl_vector_float * X, gsl_vector_float * Y, float c, float s)
- {
- if (X->size == Y->size)
- {
- cblas_srot (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride), c, s);
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_drot (gsl_vector * X, gsl_vector * Y, const double c, const double s)
- {
- if (X->size == Y->size)
- {
- cblas_drot (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride), c, s);
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* Generate modified rotation */
- int
- gsl_blas_srotmg (float d1[], float d2[], float b1[], float b2, float P[])
- {
- cblas_srotmg (d1, d2, b1, b2, P);
- return GSL_SUCCESS;
- }
- int
- gsl_blas_drotmg (double d1[], double d2[], double b1[], double b2, double P[])
- {
- cblas_drotmg (d1, d2, b1, b2, P);
- return GSL_SUCCESS;
- }
- /* Apply modified rotation */
- int
- gsl_blas_srotm (gsl_vector_float * X, gsl_vector_float * Y, const float P[])
- {
- if (X->size == Y->size)
- {
- cblas_srotm (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride), P);
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_drotm (gsl_vector * X, gsl_vector * Y, const double P[])
- {
- if (X->size != Y->size)
- {
- cblas_drotm (INT (X->size), X->data, INT (X->stride), Y->data,
- INT (Y->stride), P);
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* Scale vector */
- void
- gsl_blas_sscal (float alpha, gsl_vector_float * X)
- {
- cblas_sscal (INT (X->size), alpha, X->data, INT (X->stride));
- }
- void
- gsl_blas_dscal (double alpha, gsl_vector * X)
- {
- cblas_dscal (INT (X->size), alpha, X->data, INT (X->stride));
- }
- void
- gsl_blas_cscal (const gsl_complex_float alpha, gsl_vector_complex_float * X)
- {
- cblas_cscal (INT (X->size), GSL_COMPLEX_P (&alpha), X->data,
- INT (X->stride));
- }
- void
- gsl_blas_zscal (const gsl_complex alpha, gsl_vector_complex * X)
- {
- cblas_zscal (INT (X->size), GSL_COMPLEX_P (&alpha), X->data,
- INT (X->stride));
- }
- void
- gsl_blas_csscal (float alpha, gsl_vector_complex_float * X)
- {
- cblas_csscal (INT (X->size), alpha, X->data, INT (X->stride));
- }
- void
- gsl_blas_zdscal (double alpha, gsl_vector_complex * X)
- {
- cblas_zdscal (INT (X->size), alpha, X->data, INT (X->stride));
- }
- /* ===========================================================================
- * Level 2
- * ===========================================================================
- */
- /* GEMV */
- int
- gsl_blas_sgemv (CBLAS_TRANSPOSE_t TransA, float alpha,
- const gsl_matrix_float * A, const gsl_vector_float * X,
- float beta, gsl_vector_float * Y)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if ((TransA == CblasNoTrans && N == X->size && M == Y->size)
- || (TransA == CblasTrans && M == X->size && N == Y->size))
- {
- cblas_sgemv (CblasRowMajor, TransA, INT (M), INT (N), alpha, A->data,
- INT (A->tda), X->data, INT (X->stride), beta, Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_dgemv (CBLAS_TRANSPOSE_t TransA, double alpha, const gsl_matrix * A,
- const gsl_vector * X, double beta, gsl_vector * Y)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if ((TransA == CblasNoTrans && N == X->size && M == Y->size)
- || (TransA == CblasTrans && M == X->size && N == Y->size))
- {
- cblas_dgemv (CblasRowMajor, TransA, INT (M), INT (N), alpha, A->data,
- INT (A->tda), X->data, INT (X->stride), beta, Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_cgemv (CBLAS_TRANSPOSE_t TransA, const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- const gsl_vector_complex_float * X,
- const gsl_complex_float beta, gsl_vector_complex_float * Y)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if ((TransA == CblasNoTrans && N == X->size && M == Y->size)
- || (TransA == CblasTrans && M == X->size && N == Y->size)
- || (TransA == CblasConjTrans && M == X->size && N == Y->size))
- {
- cblas_cgemv (CblasRowMajor, TransA, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), X->data,
- INT (X->stride), GSL_COMPLEX_P (&beta), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zgemv (CBLAS_TRANSPOSE_t TransA, const gsl_complex alpha,
- const gsl_matrix_complex * A, const gsl_vector_complex * X,
- const gsl_complex beta, gsl_vector_complex * Y)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if ((TransA == CblasNoTrans && N == X->size && M == Y->size)
- || (TransA == CblasTrans && M == X->size && N == Y->size)
- || (TransA == CblasConjTrans && M == X->size && N == Y->size))
- {
- cblas_zgemv (CblasRowMajor, TransA, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), X->data,
- INT (X->stride), GSL_COMPLEX_P (&beta), Y->data,
- INT (Y->stride));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* HEMV */
- int
- gsl_blas_chemv (CBLAS_UPLO_t Uplo, const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- const gsl_vector_complex_float * X,
- const gsl_complex_float beta, gsl_vector_complex_float * Y)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size || N != Y->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_chemv (CblasRowMajor, Uplo, INT (N), GSL_COMPLEX_P (&alpha), A->data,
- INT (A->tda), X->data, INT (X->stride), GSL_COMPLEX_P (&beta),
- Y->data, INT (Y->stride));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_zhemv (CBLAS_UPLO_t Uplo, const gsl_complex alpha,
- const gsl_matrix_complex * A, const gsl_vector_complex * X,
- const gsl_complex beta, gsl_vector_complex * Y)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size || N != Y->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_zhemv (CblasRowMajor, Uplo, INT (N), GSL_COMPLEX_P (&alpha), A->data,
- INT (A->tda), X->data, INT (X->stride), GSL_COMPLEX_P (&beta),
- Y->data, INT (Y->stride));
- return GSL_SUCCESS;
- }
- /* SYMV */
- int
- gsl_blas_ssymv (CBLAS_UPLO_t Uplo, float alpha, const gsl_matrix_float * A,
- const gsl_vector_float * X, float beta, gsl_vector_float * Y)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size || N != Y->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_ssymv (CblasRowMajor, Uplo, INT (N), alpha, A->data, INT (A->tda),
- X->data, INT (X->stride), beta, Y->data, INT (Y->stride));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_dsymv (CBLAS_UPLO_t Uplo, double alpha, const gsl_matrix * A,
- const gsl_vector * X, double beta, gsl_vector * Y)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size || N != Y->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_dsymv (CblasRowMajor, Uplo, INT (N), alpha, A->data, INT (A->tda),
- X->data, INT (X->stride), beta, Y->data, INT (Y->stride));
- return GSL_SUCCESS;
- }
- /* TRMV */
- int
- gsl_blas_strmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA,
- CBLAS_DIAG_t Diag, const gsl_matrix_float * A,
- gsl_vector_float * X)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_strmv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data,
- INT (A->tda), X->data, INT (X->stride));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_dtrmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA,
- CBLAS_DIAG_t Diag, const gsl_matrix * A, gsl_vector * X)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_dtrmv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data,
- INT (A->tda), X->data, INT (X->stride));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_ctrmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA,
- CBLAS_DIAG_t Diag, const gsl_matrix_complex_float * A,
- gsl_vector_complex_float * X)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_ctrmv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data,
- INT (A->tda), X->data, INT (X->stride));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_ztrmv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA,
- CBLAS_DIAG_t Diag, const gsl_matrix_complex * A,
- gsl_vector_complex * X)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_ztrmv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data,
- INT (A->tda), X->data, INT (X->stride));
- return GSL_SUCCESS;
- }
- /* TRSV */
- int
- gsl_blas_strsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA,
- CBLAS_DIAG_t Diag, const gsl_matrix_float * A,
- gsl_vector_float * X)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_strsv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data,
- INT (A->tda), X->data, INT (X->stride));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_dtrsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA,
- CBLAS_DIAG_t Diag, const gsl_matrix * A, gsl_vector * X)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_dtrsv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data,
- INT (A->tda), X->data, INT (X->stride));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_ctrsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA,
- CBLAS_DIAG_t Diag, const gsl_matrix_complex_float * A,
- gsl_vector_complex_float * X)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_ctrsv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data,
- INT (A->tda), X->data, INT (X->stride));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_ztrsv (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t TransA,
- CBLAS_DIAG_t Diag, const gsl_matrix_complex * A,
- gsl_vector_complex * X)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (N != X->size)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_ztrsv (CblasRowMajor, Uplo, TransA, Diag, INT (N), A->data,
- INT (A->tda), X->data, INT (X->stride));
- return GSL_SUCCESS;
- }
- /* GER */
- int
- gsl_blas_sger (float alpha, const gsl_vector_float * X,
- const gsl_vector_float * Y, gsl_matrix_float * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (X->size == M && Y->size == N)
- {
- cblas_sger (CblasRowMajor, INT (M), INT (N), alpha, X->data,
- INT (X->stride), Y->data, INT (Y->stride), A->data,
- INT (A->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_dger (double alpha, const gsl_vector * X, const gsl_vector * Y,
- gsl_matrix * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (X->size == M && Y->size == N)
- {
- cblas_dger (CblasRowMajor, INT (M), INT (N), alpha, X->data,
- INT (X->stride), Y->data, INT (Y->stride), A->data,
- INT (A->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* GERU */
- int
- gsl_blas_cgeru (const gsl_complex_float alpha,
- const gsl_vector_complex_float * X,
- const gsl_vector_complex_float * Y,
- gsl_matrix_complex_float * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (X->size == M && Y->size == N)
- {
- cblas_cgeru (CblasRowMajor, INT (M), INT (N), GSL_COMPLEX_P (&alpha),
- X->data, INT (X->stride), Y->data, INT (Y->stride),
- A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zgeru (const gsl_complex alpha, const gsl_vector_complex * X,
- const gsl_vector_complex * Y, gsl_matrix_complex * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (X->size == M && Y->size == N)
- {
- cblas_zgeru (CblasRowMajor, INT (M), INT (N), GSL_COMPLEX_P (&alpha),
- X->data, INT (X->stride), Y->data, INT (Y->stride),
- A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* GERC */
- int
- gsl_blas_cgerc (const gsl_complex_float alpha,
- const gsl_vector_complex_float * X,
- const gsl_vector_complex_float * Y,
- gsl_matrix_complex_float * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (X->size == M && Y->size == N)
- {
- cblas_cgerc (CblasRowMajor, INT (M), INT (N), GSL_COMPLEX_P (&alpha),
- X->data, INT (X->stride), Y->data, INT (Y->stride),
- A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zgerc (const gsl_complex alpha, const gsl_vector_complex * X,
- const gsl_vector_complex * Y, gsl_matrix_complex * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (X->size == M && Y->size == N)
- {
- cblas_zgerc (CblasRowMajor, INT (M), INT (N), GSL_COMPLEX_P (&alpha),
- X->data, INT (X->stride), Y->data, INT (Y->stride),
- A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* HER */
- int
- gsl_blas_cher (CBLAS_UPLO_t Uplo, float alpha,
- const gsl_vector_complex_float * X,
- gsl_matrix_complex_float * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (X->size != N)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_cher (CblasRowMajor, Uplo, INT (M), alpha, X->data, INT (X->stride),
- A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_zher (CBLAS_UPLO_t Uplo, double alpha, const gsl_vector_complex * X,
- gsl_matrix_complex * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (X->size != N)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_zher (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride),
- A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- /* HER2 */
- int
- gsl_blas_cher2 (CBLAS_UPLO_t Uplo, const gsl_complex_float alpha,
- const gsl_vector_complex_float * X,
- const gsl_vector_complex_float * Y,
- gsl_matrix_complex_float * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (X->size != N || Y->size != N)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_cher2 (CblasRowMajor, Uplo, INT (N), GSL_COMPLEX_P (&alpha), X->data,
- INT (X->stride), Y->data, INT (Y->stride), A->data,
- INT (A->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_zher2 (CBLAS_UPLO_t Uplo, const gsl_complex alpha,
- const gsl_vector_complex * X, const gsl_vector_complex * Y,
- gsl_matrix_complex * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (X->size != N || Y->size != N)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_zher2 (CblasRowMajor, Uplo, INT (N), GSL_COMPLEX_P (&alpha), X->data,
- INT (X->stride), Y->data, INT (Y->stride), A->data,
- INT (A->tda));
- return GSL_SUCCESS;
- }
- /* SYR */
- int
- gsl_blas_ssyr (CBLAS_UPLO_t Uplo, float alpha, const gsl_vector_float * X,
- gsl_matrix_float * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (X->size != N)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_ssyr (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride),
- A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_dsyr (CBLAS_UPLO_t Uplo, double alpha, const gsl_vector * X,
- gsl_matrix * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (X->size != N)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_dsyr (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride),
- A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- /* SYR2 */
- int
- gsl_blas_ssyr2 (CBLAS_UPLO_t Uplo, float alpha, const gsl_vector_float * X,
- const gsl_vector_float * Y, gsl_matrix_float * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (X->size != N || Y->size != N)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_ssyr2 (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride),
- Y->data, INT (Y->stride), A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_dsyr2 (CBLAS_UPLO_t Uplo, double alpha, const gsl_vector * X,
- const gsl_vector * Y, gsl_matrix * A)
- {
- const size_t M = A->size1;
- const size_t N = A->size2;
- if (M != N)
- {
- GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
- }
- else if (X->size != N || Y->size != N)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_dsyr2 (CblasRowMajor, Uplo, INT (N), alpha, X->data, INT (X->stride),
- Y->data, INT (Y->stride), A->data, INT (A->tda));
- return GSL_SUCCESS;
- }
- /*
- * ===========================================================================
- * Prototypes for level 3 BLAS
- * ===========================================================================
- */
- /* GEMM */
- int
- gsl_blas_sgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB,
- float alpha, const gsl_matrix_float * A,
- const gsl_matrix_float * B, float beta, gsl_matrix_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (TransA == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (TransA == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (TransB == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (TransB == CblasNoTrans) ? B->size2 : B->size1;
- if (M == MA && N == NB && NA == MB) /* [MxN] = [MAxNA][MBxNB] */
- {
- cblas_sgemm (CblasRowMajor, TransA, TransB, INT (M), INT (N), INT (NA),
- alpha, A->data, INT (A->tda), B->data, INT (B->tda), beta,
- C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_dgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB,
- double alpha, const gsl_matrix * A, const gsl_matrix * B,
- double beta, gsl_matrix * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (TransA == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (TransA == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (TransB == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (TransB == CblasNoTrans) ? B->size2 : B->size1;
- if (M == MA && N == NB && NA == MB) /* [MxN] = [MAxNA][MBxNB] */
- {
- cblas_dgemm (CblasRowMajor, TransA, TransB, INT (M), INT (N), INT (NA),
- alpha, A->data, INT (A->tda), B->data, INT (B->tda), beta,
- C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_cgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB,
- const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- const gsl_matrix_complex_float * B,
- const gsl_complex_float beta, gsl_matrix_complex_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (TransA == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (TransA == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (TransB == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (TransB == CblasNoTrans) ? B->size2 : B->size1;
- if (M == MA && N == NB && NA == MB) /* [MxN] = [MAxNA][MBxNB] */
- {
- cblas_cgemm (CblasRowMajor, TransA, TransB, INT (M), INT (N), INT (NA),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), GSL_COMPLEX_P (&beta), C->data,
- INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zgemm (CBLAS_TRANSPOSE_t TransA, CBLAS_TRANSPOSE_t TransB,
- const gsl_complex alpha, const gsl_matrix_complex * A,
- const gsl_matrix_complex * B, const gsl_complex beta,
- gsl_matrix_complex * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (TransA == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (TransA == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (TransB == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (TransB == CblasNoTrans) ? B->size2 : B->size1;
- if (M == MA && N == NB && NA == MB) /* [MxN] = [MAxNA][MBxNB] */
- {
- cblas_zgemm (CblasRowMajor, TransA, TransB, INT (M), INT (N), INT (NA),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), GSL_COMPLEX_P (&beta), C->data,
- INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* SYMM */
- int
- gsl_blas_ssymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, float alpha,
- const gsl_matrix_float * A, const gsl_matrix_float * B,
- float beta, gsl_matrix_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- const size_t MB = B->size1;
- const size_t NB = B->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && (M == MA && N == NB && NA == MB))
- || (Side == CblasRight && (M == MB && N == NA && NB == MA)))
- {
- cblas_ssymm (CblasRowMajor, Side, Uplo, INT (M), INT (N), alpha,
- A->data, INT (A->tda), B->data, INT (B->tda), beta,
- C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_dsymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo, double alpha,
- const gsl_matrix * A, const gsl_matrix * B, double beta,
- gsl_matrix * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- const size_t MB = B->size1;
- const size_t NB = B->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && (M == MA && N == NB && NA == MB))
- || (Side == CblasRight && (M == MB && N == NA && NB == MA)))
- {
- cblas_dsymm (CblasRowMajor, Side, Uplo, INT (M), INT (N), alpha,
- A->data, INT (A->tda), B->data, INT (B->tda), beta,
- C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_csymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- const gsl_matrix_complex_float * B,
- const gsl_complex_float beta, gsl_matrix_complex_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- const size_t MB = B->size1;
- const size_t NB = B->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && (M == MA && N == NB && NA == MB))
- || (Side == CblasRight && (M == MB && N == NA && NB == MA)))
- {
- cblas_csymm (CblasRowMajor, Side, Uplo, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), GSL_COMPLEX_P (&beta), C->data,
- INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zsymm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- const gsl_complex alpha, const gsl_matrix_complex * A,
- const gsl_matrix_complex * B, const gsl_complex beta,
- gsl_matrix_complex * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- const size_t MB = B->size1;
- const size_t NB = B->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && (M == MA && N == NB && NA == MB))
- || (Side == CblasRight && (M == MB && N == NA && NB == MA)))
- {
- cblas_zsymm (CblasRowMajor, Side, Uplo, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), GSL_COMPLEX_P (&beta), C->data,
- INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* HEMM */
- int
- gsl_blas_chemm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- const gsl_matrix_complex_float * B,
- const gsl_complex_float beta, gsl_matrix_complex_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- const size_t MB = B->size1;
- const size_t NB = B->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && (M == MA && N == NB && NA == MB))
- || (Side == CblasRight && (M == MB && N == NA && NB == MA)))
- {
- cblas_chemm (CblasRowMajor, Side, Uplo, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), GSL_COMPLEX_P (&beta), C->data,
- INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_zhemm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- const gsl_complex alpha, const gsl_matrix_complex * A,
- const gsl_matrix_complex * B, const gsl_complex beta,
- gsl_matrix_complex * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- const size_t MB = B->size1;
- const size_t NB = B->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && (M == MA && N == NB && NA == MB))
- || (Side == CblasRight && (M == MB && N == NA && NB == MA)))
- {
- cblas_zhemm (CblasRowMajor, Side, Uplo, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), GSL_COMPLEX_P (&beta), C->data,
- INT (C->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* SYRK */
- int
- gsl_blas_ssyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, float alpha,
- const gsl_matrix_float * A, float beta, gsl_matrix_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != J)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_ssyrk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), alpha, A->data,
- INT (A->tda), beta, C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_dsyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha,
- const gsl_matrix * A, double beta, gsl_matrix * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != J)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_dsyrk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), alpha, A->data,
- INT (A->tda), beta, C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_csyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans,
- const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- const gsl_complex_float beta, gsl_matrix_complex_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != J)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_csyrk (CblasRowMajor, Uplo, Trans, INT (N), INT (K),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda),
- GSL_COMPLEX_P (&beta), C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_zsyrk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans,
- const gsl_complex alpha, const gsl_matrix_complex * A,
- const gsl_complex beta, gsl_matrix_complex * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != J)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_zsyrk (CblasRowMajor, Uplo, Trans, INT (N), INT (K),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda),
- GSL_COMPLEX_P (&beta), C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- /* HERK */
- int
- gsl_blas_cherk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, float alpha,
- const gsl_matrix_complex_float * A, float beta,
- gsl_matrix_complex_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != J)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_cherk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), alpha, A->data,
- INT (A->tda), beta, C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_zherk (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha,
- const gsl_matrix_complex * A, double beta,
- gsl_matrix_complex * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t J = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t K = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != J)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_zherk (CblasRowMajor, Uplo, Trans, INT (N), INT (K), alpha, A->data,
- INT (A->tda), beta, C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- /* SYR2K */
- int
- gsl_blas_ssyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, float alpha,
- const gsl_matrix_float * A, const gsl_matrix_float * B,
- float beta, gsl_matrix_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != MA || N != MB || NA != NB)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_ssyr2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA), alpha, A->data,
- INT (A->tda), B->data, INT (B->tda), beta, C->data,
- INT (C->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_dsyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans, double alpha,
- const gsl_matrix * A, const gsl_matrix * B, double beta,
- gsl_matrix * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != MA || N != MB || NA != NB)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_dsyr2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA), alpha, A->data,
- INT (A->tda), B->data, INT (B->tda), beta, C->data,
- INT (C->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_csyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans,
- const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- const gsl_matrix_complex_float * B,
- const gsl_complex_float beta, gsl_matrix_complex_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != MA || N != MB || NA != NB)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_csyr2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), GSL_COMPLEX_P (&beta), C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_zsyr2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans,
- const gsl_complex alpha, const gsl_matrix_complex * A,
- const gsl_matrix_complex * B, const gsl_complex beta,
- gsl_matrix_complex * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != MA || N != MB || NA != NB)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_zsyr2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), GSL_COMPLEX_P (&beta), C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- /* HER2K */
- int
- gsl_blas_cher2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans,
- const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- const gsl_matrix_complex_float * B, float beta,
- gsl_matrix_complex_float * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != MA || N != MB || NA != NB)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_cher2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), beta, C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- int
- gsl_blas_zher2k (CBLAS_UPLO_t Uplo, CBLAS_TRANSPOSE_t Trans,
- const gsl_complex alpha, const gsl_matrix_complex * A,
- const gsl_matrix_complex * B, double beta,
- gsl_matrix_complex * C)
- {
- const size_t M = C->size1;
- const size_t N = C->size2;
- const size_t MA = (Trans == CblasNoTrans) ? A->size1 : A->size2;
- const size_t NA = (Trans == CblasNoTrans) ? A->size2 : A->size1;
- const size_t MB = (Trans == CblasNoTrans) ? B->size1 : B->size2;
- const size_t NB = (Trans == CblasNoTrans) ? B->size2 : B->size1;
- if (M != N)
- {
- GSL_ERROR ("matrix C must be square", GSL_ENOTSQR);
- }
- else if (N != MA || N != MB || NA != NB)
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- cblas_zher2k (CblasRowMajor, Uplo, Trans, INT (N), INT (NA),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda), beta, C->data, INT (C->tda));
- return GSL_SUCCESS;
- }
- /* TRMM */
- int
- gsl_blas_strmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, float alpha,
- const gsl_matrix_float * A, gsl_matrix_float * B)
- {
- const size_t M = B->size1;
- const size_t N = B->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA))
- {
- cblas_strmm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N),
- alpha, A->data, INT (A->tda), B->data, INT (B->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_dtrmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, double alpha,
- const gsl_matrix * A, gsl_matrix * B)
- {
- const size_t M = B->size1;
- const size_t N = B->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA))
- {
- cblas_dtrmm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N),
- alpha, A->data, INT (A->tda), B->data, INT (B->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_ctrmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag,
- const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- gsl_matrix_complex_float * B)
- {
- const size_t M = B->size1;
- const size_t N = B->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA))
- {
- cblas_ctrmm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_ztrmm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag,
- const gsl_complex alpha, const gsl_matrix_complex * A,
- gsl_matrix_complex * B)
- {
- const size_t M = B->size1;
- const size_t N = B->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA))
- {
- cblas_ztrmm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- /* TRSM */
- int
- gsl_blas_strsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, float alpha,
- const gsl_matrix_float * A, gsl_matrix_float * B)
- {
- const size_t M = B->size1;
- const size_t N = B->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA))
- {
- cblas_strsm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N),
- alpha, A->data, INT (A->tda), B->data, INT (B->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_dtrsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag, double alpha,
- const gsl_matrix * A, gsl_matrix * B)
- {
- const size_t M = B->size1;
- const size_t N = B->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA))
- {
- cblas_dtrsm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N),
- alpha, A->data, INT (A->tda), B->data, INT (B->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_ctrsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag,
- const gsl_complex_float alpha,
- const gsl_matrix_complex_float * A,
- gsl_matrix_complex_float * B)
- {
- const size_t M = B->size1;
- const size_t N = B->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA))
- {
- cblas_ctrsm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
- int
- gsl_blas_ztrsm (CBLAS_SIDE_t Side, CBLAS_UPLO_t Uplo,
- CBLAS_TRANSPOSE_t TransA, CBLAS_DIAG_t Diag,
- const gsl_complex alpha, const gsl_matrix_complex * A,
- gsl_matrix_complex * B)
- {
- const size_t M = B->size1;
- const size_t N = B->size2;
- const size_t MA = A->size1;
- const size_t NA = A->size2;
- if (MA != NA)
- {
- GSL_ERROR ("matrix A must be square", GSL_ENOTSQR);
- }
- if ((Side == CblasLeft && M == MA) || (Side == CblasRight && N == MA))
- {
- cblas_ztrsm (CblasRowMajor, Side, Uplo, TransA, Diag, INT (M), INT (N),
- GSL_COMPLEX_P (&alpha), A->data, INT (A->tda), B->data,
- INT (B->tda));
- return GSL_SUCCESS;
- }
- else
- {
- GSL_ERROR ("invalid length", GSL_EBADLEN);
- }
- }
|