dgesvd.c 129 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051
  1. /* dgesvd.f -- translated by f2c (version 20061008).
  2. You must link the resulting object file with libf2c:
  3. on Microsoft Windows system, link with libf2c.lib;
  4. on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  5. or, if you install libf2c.a in a standard place, with -lf2c -lm
  6. -- in that order, at the end of the command line, as in
  7. cc *.o -lf2c -lm
  8. Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
  9. http://www.netlib.org/f2c/libf2c.zip
  10. */
  11. #include "f2c.h"
  12. #include "blaswrap.h"
  13. /* Table of constant values */
  14. static integer c__6 = 6;
  15. static integer c__0 = 0;
  16. static integer c__2 = 2;
  17. static integer c__1 = 1;
  18. static integer c_n1 = -1;
  19. static doublereal c_b421 = 0.;
  20. static doublereal c_b443 = 1.;
  21. /* Subroutine */ int _starpu_dgesvd_(char *jobu, char *jobvt, integer *m, integer *n,
  22. doublereal *a, integer *lda, doublereal *s, doublereal *u, integer *
  23. ldu, doublereal *vt, integer *ldvt, doublereal *work, integer *lwork,
  24. integer *info)
  25. {
  26. /* System generated locals */
  27. address a__1[2];
  28. integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2],
  29. i__2, i__3, i__4;
  30. char ch__1[2];
  31. /* Builtin functions */
  32. /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
  33. double sqrt(doublereal);
  34. /* Local variables */
  35. integer i__, ie, ir, iu, blk, ncu;
  36. doublereal dum[1], eps;
  37. integer nru, iscl;
  38. doublereal anrm;
  39. integer ierr, itau, ncvt, nrvt;
  40. extern /* Subroutine */ int _starpu_dgemm_(char *, char *, integer *, integer *,
  41. integer *, doublereal *, doublereal *, integer *, doublereal *,
  42. integer *, doublereal *, doublereal *, integer *);
  43. extern logical _starpu_lsame_(char *, char *);
  44. integer chunk, minmn, wrkbl, itaup, itauq, mnthr, iwork;
  45. logical wntua, wntva, wntun, wntuo, wntvn, wntvo, wntus, wntvs;
  46. extern /* Subroutine */ int _starpu_dgebrd_(integer *, integer *, doublereal *,
  47. integer *, doublereal *, doublereal *, doublereal *, doublereal *,
  48. doublereal *, integer *, integer *);
  49. extern doublereal _starpu_dlamch_(char *), _starpu_dlange_(char *, integer *,
  50. integer *, doublereal *, integer *, doublereal *);
  51. integer bdspac;
  52. extern /* Subroutine */ int _starpu_dgelqf_(integer *, integer *, doublereal *,
  53. integer *, doublereal *, doublereal *, integer *, integer *),
  54. _starpu_dlascl_(char *, integer *, integer *, doublereal *, doublereal *,
  55. integer *, integer *, doublereal *, integer *, integer *),
  56. _starpu_dgeqrf_(integer *, integer *, doublereal *, integer *,
  57. doublereal *, doublereal *, integer *, integer *), _starpu_dlacpy_(char *,
  58. integer *, integer *, doublereal *, integer *, doublereal *,
  59. integer *), _starpu_dlaset_(char *, integer *, integer *,
  60. doublereal *, doublereal *, doublereal *, integer *),
  61. _starpu_dbdsqr_(char *, integer *, integer *, integer *, integer *,
  62. doublereal *, doublereal *, doublereal *, integer *, doublereal *,
  63. integer *, doublereal *, integer *, doublereal *, integer *), _starpu_dorgbr_(char *, integer *, integer *, integer *,
  64. doublereal *, integer *, doublereal *, doublereal *, integer *,
  65. integer *);
  66. doublereal bignum;
  67. extern /* Subroutine */ int _starpu_xerbla_(char *, integer *);
  68. extern integer _starpu_ilaenv_(integer *, char *, char *, integer *, integer *,
  69. integer *, integer *);
  70. extern /* Subroutine */ int _starpu_dormbr_(char *, char *, char *, integer *,
  71. integer *, integer *, doublereal *, integer *, doublereal *,
  72. doublereal *, integer *, doublereal *, integer *, integer *), _starpu_dorglq_(integer *, integer *, integer *,
  73. doublereal *, integer *, doublereal *, doublereal *, integer *,
  74. integer *), _starpu_dorgqr_(integer *, integer *, integer *, doublereal *,
  75. integer *, doublereal *, doublereal *, integer *, integer *);
  76. integer ldwrkr, minwrk, ldwrku, maxwrk;
  77. doublereal smlnum;
  78. logical lquery, wntuas, wntvas;
  79. /* -- LAPACK driver routine (version 3.2) -- */
  80. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  81. /* November 2006 */
  82. /* .. Scalar Arguments .. */
  83. /* .. */
  84. /* .. Array Arguments .. */
  85. /* .. */
  86. /* Purpose */
  87. /* ======= */
  88. /* DGESVD computes the singular value decomposition (SVD) of a real */
  89. /* M-by-N matrix A, optionally computing the left and/or right singular */
  90. /* vectors. The SVD is written */
  91. /* A = U * SIGMA * transpose(V) */
  92. /* where SIGMA is an M-by-N matrix which is zero except for its */
  93. /* min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and */
  94. /* V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA */
  95. /* are the singular values of A; they are real and non-negative, and */
  96. /* are returned in descending order. The first min(m,n) columns of */
  97. /* U and V are the left and right singular vectors of A. */
  98. /* Note that the routine returns V**T, not V. */
  99. /* Arguments */
  100. /* ========= */
  101. /* JOBU (input) CHARACTER*1 */
  102. /* Specifies options for computing all or part of the matrix U: */
  103. /* = 'A': all M columns of U are returned in array U: */
  104. /* = 'S': the first min(m,n) columns of U (the left singular */
  105. /* vectors) are returned in the array U; */
  106. /* = 'O': the first min(m,n) columns of U (the left singular */
  107. /* vectors) are overwritten on the array A; */
  108. /* = 'N': no columns of U (no left singular vectors) are */
  109. /* computed. */
  110. /* JOBVT (input) CHARACTER*1 */
  111. /* Specifies options for computing all or part of the matrix */
  112. /* V**T: */
  113. /* = 'A': all N rows of V**T are returned in the array VT; */
  114. /* = 'S': the first min(m,n) rows of V**T (the right singular */
  115. /* vectors) are returned in the array VT; */
  116. /* = 'O': the first min(m,n) rows of V**T (the right singular */
  117. /* vectors) are overwritten on the array A; */
  118. /* = 'N': no rows of V**T (no right singular vectors) are */
  119. /* computed. */
  120. /* JOBVT and JOBU cannot both be 'O'. */
  121. /* M (input) INTEGER */
  122. /* The number of rows of the input matrix A. M >= 0. */
  123. /* N (input) INTEGER */
  124. /* The number of columns of the input matrix A. N >= 0. */
  125. /* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
  126. /* On entry, the M-by-N matrix A. */
  127. /* On exit, */
  128. /* if JOBU = 'O', A is overwritten with the first min(m,n) */
  129. /* columns of U (the left singular vectors, */
  130. /* stored columnwise); */
  131. /* if JOBVT = 'O', A is overwritten with the first min(m,n) */
  132. /* rows of V**T (the right singular vectors, */
  133. /* stored rowwise); */
  134. /* if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A */
  135. /* are destroyed. */
  136. /* LDA (input) INTEGER */
  137. /* The leading dimension of the array A. LDA >= max(1,M). */
  138. /* S (output) DOUBLE PRECISION array, dimension (min(M,N)) */
  139. /* The singular values of A, sorted so that S(i) >= S(i+1). */
  140. /* U (output) DOUBLE PRECISION array, dimension (LDU,UCOL) */
  141. /* (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'. */
  142. /* If JOBU = 'A', U contains the M-by-M orthogonal matrix U; */
  143. /* if JOBU = 'S', U contains the first min(m,n) columns of U */
  144. /* (the left singular vectors, stored columnwise); */
  145. /* if JOBU = 'N' or 'O', U is not referenced. */
  146. /* LDU (input) INTEGER */
  147. /* The leading dimension of the array U. LDU >= 1; if */
  148. /* JOBU = 'S' or 'A', LDU >= M. */
  149. /* VT (output) DOUBLE PRECISION array, dimension (LDVT,N) */
  150. /* If JOBVT = 'A', VT contains the N-by-N orthogonal matrix */
  151. /* V**T; */
  152. /* if JOBVT = 'S', VT contains the first min(m,n) rows of */
  153. /* V**T (the right singular vectors, stored rowwise); */
  154. /* if JOBVT = 'N' or 'O', VT is not referenced. */
  155. /* LDVT (input) INTEGER */
  156. /* The leading dimension of the array VT. LDVT >= 1; if */
  157. /* JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N). */
  158. /* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
  159. /* On exit, if INFO = 0, WORK(1) returns the optimal LWORK; */
  160. /* if INFO > 0, WORK(2:MIN(M,N)) contains the unconverged */
  161. /* superdiagonal elements of an upper bidiagonal matrix B */
  162. /* whose diagonal is in S (not necessarily sorted). B */
  163. /* satisfies A = U * B * VT, so it has the same singular values */
  164. /* as A, and singular vectors related by U and VT. */
  165. /* LWORK (input) INTEGER */
  166. /* The dimension of the array WORK. */
  167. /* LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)). */
  168. /* For good performance, LWORK should generally be larger. */
  169. /* If LWORK = -1, then a workspace query is assumed; the routine */
  170. /* only calculates the optimal size of the WORK array, returns */
  171. /* this value as the first entry of the WORK array, and no error */
  172. /* message related to LWORK is issued by XERBLA. */
  173. /* INFO (output) INTEGER */
  174. /* = 0: successful exit. */
  175. /* < 0: if INFO = -i, the i-th argument had an illegal value. */
  176. /* > 0: if DBDSQR did not converge, INFO specifies how many */
  177. /* superdiagonals of an intermediate bidiagonal form B */
  178. /* did not converge to zero. See the description of WORK */
  179. /* above for details. */
  180. /* ===================================================================== */
  181. /* .. Parameters .. */
  182. /* .. */
  183. /* .. Local Scalars .. */
  184. /* .. */
  185. /* .. Local Arrays .. */
  186. /* .. */
  187. /* .. External Subroutines .. */
  188. /* .. */
  189. /* .. External Functions .. */
  190. /* .. */
  191. /* .. Intrinsic Functions .. */
  192. /* .. */
  193. /* .. Executable Statements .. */
  194. /* Test the input arguments */
  195. /* Parameter adjustments */
  196. a_dim1 = *lda;
  197. a_offset = 1 + a_dim1;
  198. a -= a_offset;
  199. --s;
  200. u_dim1 = *ldu;
  201. u_offset = 1 + u_dim1;
  202. u -= u_offset;
  203. vt_dim1 = *ldvt;
  204. vt_offset = 1 + vt_dim1;
  205. vt -= vt_offset;
  206. --work;
  207. /* Function Body */
  208. *info = 0;
  209. minmn = min(*m,*n);
  210. wntua = _starpu_lsame_(jobu, "A");
  211. wntus = _starpu_lsame_(jobu, "S");
  212. wntuas = wntua || wntus;
  213. wntuo = _starpu_lsame_(jobu, "O");
  214. wntun = _starpu_lsame_(jobu, "N");
  215. wntva = _starpu_lsame_(jobvt, "A");
  216. wntvs = _starpu_lsame_(jobvt, "S");
  217. wntvas = wntva || wntvs;
  218. wntvo = _starpu_lsame_(jobvt, "O");
  219. wntvn = _starpu_lsame_(jobvt, "N");
  220. lquery = *lwork == -1;
  221. if (! (wntua || wntus || wntuo || wntun)) {
  222. *info = -1;
  223. } else if (! (wntva || wntvs || wntvo || wntvn) || wntvo && wntuo) {
  224. *info = -2;
  225. } else if (*m < 0) {
  226. *info = -3;
  227. } else if (*n < 0) {
  228. *info = -4;
  229. } else if (*lda < max(1,*m)) {
  230. *info = -6;
  231. } else if (*ldu < 1 || wntuas && *ldu < *m) {
  232. *info = -9;
  233. } else if (*ldvt < 1 || wntva && *ldvt < *n || wntvs && *ldvt < minmn) {
  234. *info = -11;
  235. }
  236. /* Compute workspace */
  237. /* (Note: Comments in the code beginning "Workspace:" describe the */
  238. /* minimal amount of workspace needed at that point in the code, */
  239. /* as well as the preferred amount for good performance. */
  240. /* NB refers to the optimal block size for the immediately */
  241. /* following subroutine, as returned by ILAENV.) */
  242. if (*info == 0) {
  243. minwrk = 1;
  244. maxwrk = 1;
  245. if (*m >= *n && minmn > 0) {
  246. /* Compute space needed for DBDSQR */
  247. /* Writing concatenation */
  248. i__1[0] = 1, a__1[0] = jobu;
  249. i__1[1] = 1, a__1[1] = jobvt;
  250. s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
  251. mnthr = _starpu_ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0);
  252. bdspac = *n * 5;
  253. if (*m >= mnthr) {
  254. if (wntun) {
  255. /* Path 1 (M much larger than N, JOBU='N') */
  256. maxwrk = *n + *n * _starpu_ilaenv_(&c__1, "DGEQRF", " ", m, n, &
  257. c_n1, &c_n1);
  258. /* Computing MAX */
  259. i__2 = maxwrk, i__3 = *n * 3 + (*n << 1) * _starpu_ilaenv_(&c__1,
  260. "DGEBRD", " ", n, n, &c_n1, &c_n1);
  261. maxwrk = max(i__2,i__3);
  262. if (wntvo || wntvas) {
  263. /* Computing MAX */
  264. i__2 = maxwrk, i__3 = *n * 3 + (*n - 1) * _starpu_ilaenv_(&
  265. c__1, "DORGBR", "P", n, n, n, &c_n1);
  266. maxwrk = max(i__2,i__3);
  267. }
  268. maxwrk = max(maxwrk,bdspac);
  269. /* Computing MAX */
  270. i__2 = *n << 2;
  271. minwrk = max(i__2,bdspac);
  272. } else if (wntuo && wntvn) {
  273. /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */
  274. wrkbl = *n + *n * _starpu_ilaenv_(&c__1, "DGEQRF", " ", m, n, &
  275. c_n1, &c_n1);
  276. /* Computing MAX */
  277. i__2 = wrkbl, i__3 = *n + *n * _starpu_ilaenv_(&c__1, "DORGQR",
  278. " ", m, n, n, &c_n1);
  279. wrkbl = max(i__2,i__3);
  280. /* Computing MAX */
  281. i__2 = wrkbl, i__3 = *n * 3 + (*n << 1) * _starpu_ilaenv_(&c__1,
  282. "DGEBRD", " ", n, n, &c_n1, &c_n1);
  283. wrkbl = max(i__2,i__3);
  284. /* Computing MAX */
  285. i__2 = wrkbl, i__3 = *n * 3 + *n * _starpu_ilaenv_(&c__1, "DORGBR"
  286. , "Q", n, n, n, &c_n1);
  287. wrkbl = max(i__2,i__3);
  288. wrkbl = max(wrkbl,bdspac);
  289. /* Computing MAX */
  290. i__2 = *n * *n + wrkbl, i__3 = *n * *n + *m * *n + *n;
  291. maxwrk = max(i__2,i__3);
  292. /* Computing MAX */
  293. i__2 = *n * 3 + *m;
  294. minwrk = max(i__2,bdspac);
  295. } else if (wntuo && wntvas) {
  296. /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or */
  297. /* 'A') */
  298. wrkbl = *n + *n * _starpu_ilaenv_(&c__1, "DGEQRF", " ", m, n, &
  299. c_n1, &c_n1);
  300. /* Computing MAX */
  301. i__2 = wrkbl, i__3 = *n + *n * _starpu_ilaenv_(&c__1, "DORGQR",
  302. " ", m, n, n, &c_n1);
  303. wrkbl = max(i__2,i__3);
  304. /* Computing MAX */
  305. i__2 = wrkbl, i__3 = *n * 3 + (*n << 1) * _starpu_ilaenv_(&c__1,
  306. "DGEBRD", " ", n, n, &c_n1, &c_n1);
  307. wrkbl = max(i__2,i__3);
  308. /* Computing MAX */
  309. i__2 = wrkbl, i__3 = *n * 3 + *n * _starpu_ilaenv_(&c__1, "DORGBR"
  310. , "Q", n, n, n, &c_n1);
  311. wrkbl = max(i__2,i__3);
  312. /* Computing MAX */
  313. i__2 = wrkbl, i__3 = *n * 3 + (*n - 1) * _starpu_ilaenv_(&c__1,
  314. "DORGBR", "P", n, n, n, &c_n1);
  315. wrkbl = max(i__2,i__3);
  316. wrkbl = max(wrkbl,bdspac);
  317. /* Computing MAX */
  318. i__2 = *n * *n + wrkbl, i__3 = *n * *n + *m * *n + *n;
  319. maxwrk = max(i__2,i__3);
  320. /* Computing MAX */
  321. i__2 = *n * 3 + *m;
  322. minwrk = max(i__2,bdspac);
  323. } else if (wntus && wntvn) {
  324. /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */
  325. wrkbl = *n + *n * _starpu_ilaenv_(&c__1, "DGEQRF", " ", m, n, &
  326. c_n1, &c_n1);
  327. /* Computing MAX */
  328. i__2 = wrkbl, i__3 = *n + *n * _starpu_ilaenv_(&c__1, "DORGQR",
  329. " ", m, n, n, &c_n1);
  330. wrkbl = max(i__2,i__3);
  331. /* Computing MAX */
  332. i__2 = wrkbl, i__3 = *n * 3 + (*n << 1) * _starpu_ilaenv_(&c__1,
  333. "DGEBRD", " ", n, n, &c_n1, &c_n1);
  334. wrkbl = max(i__2,i__3);
  335. /* Computing MAX */
  336. i__2 = wrkbl, i__3 = *n * 3 + *n * _starpu_ilaenv_(&c__1, "DORGBR"
  337. , "Q", n, n, n, &c_n1);
  338. wrkbl = max(i__2,i__3);
  339. wrkbl = max(wrkbl,bdspac);
  340. maxwrk = *n * *n + wrkbl;
  341. /* Computing MAX */
  342. i__2 = *n * 3 + *m;
  343. minwrk = max(i__2,bdspac);
  344. } else if (wntus && wntvo) {
  345. /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */
  346. wrkbl = *n + *n * _starpu_ilaenv_(&c__1, "DGEQRF", " ", m, n, &
  347. c_n1, &c_n1);
  348. /* Computing MAX */
  349. i__2 = wrkbl, i__3 = *n + *n * _starpu_ilaenv_(&c__1, "DORGQR",
  350. " ", m, n, n, &c_n1);
  351. wrkbl = max(i__2,i__3);
  352. /* Computing MAX */
  353. i__2 = wrkbl, i__3 = *n * 3 + (*n << 1) * _starpu_ilaenv_(&c__1,
  354. "DGEBRD", " ", n, n, &c_n1, &c_n1);
  355. wrkbl = max(i__2,i__3);
  356. /* Computing MAX */
  357. i__2 = wrkbl, i__3 = *n * 3 + *n * _starpu_ilaenv_(&c__1, "DORGBR"
  358. , "Q", n, n, n, &c_n1);
  359. wrkbl = max(i__2,i__3);
  360. /* Computing MAX */
  361. i__2 = wrkbl, i__3 = *n * 3 + (*n - 1) * _starpu_ilaenv_(&c__1,
  362. "DORGBR", "P", n, n, n, &c_n1);
  363. wrkbl = max(i__2,i__3);
  364. wrkbl = max(wrkbl,bdspac);
  365. maxwrk = (*n << 1) * *n + wrkbl;
  366. /* Computing MAX */
  367. i__2 = *n * 3 + *m;
  368. minwrk = max(i__2,bdspac);
  369. } else if (wntus && wntvas) {
  370. /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or */
  371. /* 'A') */
  372. wrkbl = *n + *n * _starpu_ilaenv_(&c__1, "DGEQRF", " ", m, n, &
  373. c_n1, &c_n1);
  374. /* Computing MAX */
  375. i__2 = wrkbl, i__3 = *n + *n * _starpu_ilaenv_(&c__1, "DORGQR",
  376. " ", m, n, n, &c_n1);
  377. wrkbl = max(i__2,i__3);
  378. /* Computing MAX */
  379. i__2 = wrkbl, i__3 = *n * 3 + (*n << 1) * _starpu_ilaenv_(&c__1,
  380. "DGEBRD", " ", n, n, &c_n1, &c_n1);
  381. wrkbl = max(i__2,i__3);
  382. /* Computing MAX */
  383. i__2 = wrkbl, i__3 = *n * 3 + *n * _starpu_ilaenv_(&c__1, "DORGBR"
  384. , "Q", n, n, n, &c_n1);
  385. wrkbl = max(i__2,i__3);
  386. /* Computing MAX */
  387. i__2 = wrkbl, i__3 = *n * 3 + (*n - 1) * _starpu_ilaenv_(&c__1,
  388. "DORGBR", "P", n, n, n, &c_n1);
  389. wrkbl = max(i__2,i__3);
  390. wrkbl = max(wrkbl,bdspac);
  391. maxwrk = *n * *n + wrkbl;
  392. /* Computing MAX */
  393. i__2 = *n * 3 + *m;
  394. minwrk = max(i__2,bdspac);
  395. } else if (wntua && wntvn) {
  396. /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */
  397. wrkbl = *n + *n * _starpu_ilaenv_(&c__1, "DGEQRF", " ", m, n, &
  398. c_n1, &c_n1);
  399. /* Computing MAX */
  400. i__2 = wrkbl, i__3 = *n + *m * _starpu_ilaenv_(&c__1, "DORGQR",
  401. " ", m, m, n, &c_n1);
  402. wrkbl = max(i__2,i__3);
  403. /* Computing MAX */
  404. i__2 = wrkbl, i__3 = *n * 3 + (*n << 1) * _starpu_ilaenv_(&c__1,
  405. "DGEBRD", " ", n, n, &c_n1, &c_n1);
  406. wrkbl = max(i__2,i__3);
  407. /* Computing MAX */
  408. i__2 = wrkbl, i__3 = *n * 3 + *n * _starpu_ilaenv_(&c__1, "DORGBR"
  409. , "Q", n, n, n, &c_n1);
  410. wrkbl = max(i__2,i__3);
  411. wrkbl = max(wrkbl,bdspac);
  412. maxwrk = *n * *n + wrkbl;
  413. /* Computing MAX */
  414. i__2 = *n * 3 + *m;
  415. minwrk = max(i__2,bdspac);
  416. } else if (wntua && wntvo) {
  417. /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */
  418. wrkbl = *n + *n * _starpu_ilaenv_(&c__1, "DGEQRF", " ", m, n, &
  419. c_n1, &c_n1);
  420. /* Computing MAX */
  421. i__2 = wrkbl, i__3 = *n + *m * _starpu_ilaenv_(&c__1, "DORGQR",
  422. " ", m, m, n, &c_n1);
  423. wrkbl = max(i__2,i__3);
  424. /* Computing MAX */
  425. i__2 = wrkbl, i__3 = *n * 3 + (*n << 1) * _starpu_ilaenv_(&c__1,
  426. "DGEBRD", " ", n, n, &c_n1, &c_n1);
  427. wrkbl = max(i__2,i__3);
  428. /* Computing MAX */
  429. i__2 = wrkbl, i__3 = *n * 3 + *n * _starpu_ilaenv_(&c__1, "DORGBR"
  430. , "Q", n, n, n, &c_n1);
  431. wrkbl = max(i__2,i__3);
  432. /* Computing MAX */
  433. i__2 = wrkbl, i__3 = *n * 3 + (*n - 1) * _starpu_ilaenv_(&c__1,
  434. "DORGBR", "P", n, n, n, &c_n1);
  435. wrkbl = max(i__2,i__3);
  436. wrkbl = max(wrkbl,bdspac);
  437. maxwrk = (*n << 1) * *n + wrkbl;
  438. /* Computing MAX */
  439. i__2 = *n * 3 + *m;
  440. minwrk = max(i__2,bdspac);
  441. } else if (wntua && wntvas) {
  442. /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or */
  443. /* 'A') */
  444. wrkbl = *n + *n * _starpu_ilaenv_(&c__1, "DGEQRF", " ", m, n, &
  445. c_n1, &c_n1);
  446. /* Computing MAX */
  447. i__2 = wrkbl, i__3 = *n + *m * _starpu_ilaenv_(&c__1, "DORGQR",
  448. " ", m, m, n, &c_n1);
  449. wrkbl = max(i__2,i__3);
  450. /* Computing MAX */
  451. i__2 = wrkbl, i__3 = *n * 3 + (*n << 1) * _starpu_ilaenv_(&c__1,
  452. "DGEBRD", " ", n, n, &c_n1, &c_n1);
  453. wrkbl = max(i__2,i__3);
  454. /* Computing MAX */
  455. i__2 = wrkbl, i__3 = *n * 3 + *n * _starpu_ilaenv_(&c__1, "DORGBR"
  456. , "Q", n, n, n, &c_n1);
  457. wrkbl = max(i__2,i__3);
  458. /* Computing MAX */
  459. i__2 = wrkbl, i__3 = *n * 3 + (*n - 1) * _starpu_ilaenv_(&c__1,
  460. "DORGBR", "P", n, n, n, &c_n1);
  461. wrkbl = max(i__2,i__3);
  462. wrkbl = max(wrkbl,bdspac);
  463. maxwrk = *n * *n + wrkbl;
  464. /* Computing MAX */
  465. i__2 = *n * 3 + *m;
  466. minwrk = max(i__2,bdspac);
  467. }
  468. } else {
  469. /* Path 10 (M at least N, but not much larger) */
  470. maxwrk = *n * 3 + (*m + *n) * _starpu_ilaenv_(&c__1, "DGEBRD", " ", m,
  471. n, &c_n1, &c_n1);
  472. if (wntus || wntuo) {
  473. /* Computing MAX */
  474. i__2 = maxwrk, i__3 = *n * 3 + *n * _starpu_ilaenv_(&c__1, "DORG"
  475. "BR", "Q", m, n, n, &c_n1);
  476. maxwrk = max(i__2,i__3);
  477. }
  478. if (wntua) {
  479. /* Computing MAX */
  480. i__2 = maxwrk, i__3 = *n * 3 + *m * _starpu_ilaenv_(&c__1, "DORG"
  481. "BR", "Q", m, m, n, &c_n1);
  482. maxwrk = max(i__2,i__3);
  483. }
  484. if (! wntvn) {
  485. /* Computing MAX */
  486. i__2 = maxwrk, i__3 = *n * 3 + (*n - 1) * _starpu_ilaenv_(&c__1,
  487. "DORGBR", "P", n, n, n, &c_n1);
  488. maxwrk = max(i__2,i__3);
  489. }
  490. maxwrk = max(maxwrk,bdspac);
  491. /* Computing MAX */
  492. i__2 = *n * 3 + *m;
  493. minwrk = max(i__2,bdspac);
  494. }
  495. } else if (minmn > 0) {
  496. /* Compute space needed for DBDSQR */
  497. /* Writing concatenation */
  498. i__1[0] = 1, a__1[0] = jobu;
  499. i__1[1] = 1, a__1[1] = jobvt;
  500. s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
  501. mnthr = _starpu_ilaenv_(&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0);
  502. bdspac = *m * 5;
  503. if (*n >= mnthr) {
  504. if (wntvn) {
  505. /* Path 1t(N much larger than M, JOBVT='N') */
  506. maxwrk = *m + *m * _starpu_ilaenv_(&c__1, "DGELQF", " ", m, n, &
  507. c_n1, &c_n1);
  508. /* Computing MAX */
  509. i__2 = maxwrk, i__3 = *m * 3 + (*m << 1) * _starpu_ilaenv_(&c__1,
  510. "DGEBRD", " ", m, m, &c_n1, &c_n1);
  511. maxwrk = max(i__2,i__3);
  512. if (wntuo || wntuas) {
  513. /* Computing MAX */
  514. i__2 = maxwrk, i__3 = *m * 3 + *m * _starpu_ilaenv_(&c__1,
  515. "DORGBR", "Q", m, m, m, &c_n1);
  516. maxwrk = max(i__2,i__3);
  517. }
  518. maxwrk = max(maxwrk,bdspac);
  519. /* Computing MAX */
  520. i__2 = *m << 2;
  521. minwrk = max(i__2,bdspac);
  522. } else if (wntvo && wntun) {
  523. /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */
  524. wrkbl = *m + *m * _starpu_ilaenv_(&c__1, "DGELQF", " ", m, n, &
  525. c_n1, &c_n1);
  526. /* Computing MAX */
  527. i__2 = wrkbl, i__3 = *m + *m * _starpu_ilaenv_(&c__1, "DORGLQ",
  528. " ", m, n, m, &c_n1);
  529. wrkbl = max(i__2,i__3);
  530. /* Computing MAX */
  531. i__2 = wrkbl, i__3 = *m * 3 + (*m << 1) * _starpu_ilaenv_(&c__1,
  532. "DGEBRD", " ", m, m, &c_n1, &c_n1);
  533. wrkbl = max(i__2,i__3);
  534. /* Computing MAX */
  535. i__2 = wrkbl, i__3 = *m * 3 + (*m - 1) * _starpu_ilaenv_(&c__1,
  536. "DORGBR", "P", m, m, m, &c_n1);
  537. wrkbl = max(i__2,i__3);
  538. wrkbl = max(wrkbl,bdspac);
  539. /* Computing MAX */
  540. i__2 = *m * *m + wrkbl, i__3 = *m * *m + *m * *n + *m;
  541. maxwrk = max(i__2,i__3);
  542. /* Computing MAX */
  543. i__2 = *m * 3 + *n;
  544. minwrk = max(i__2,bdspac);
  545. } else if (wntvo && wntuas) {
  546. /* Path 3t(N much larger than M, JOBU='S' or 'A', */
  547. /* JOBVT='O') */
  548. wrkbl = *m + *m * _starpu_ilaenv_(&c__1, "DGELQF", " ", m, n, &
  549. c_n1, &c_n1);
  550. /* Computing MAX */
  551. i__2 = wrkbl, i__3 = *m + *m * _starpu_ilaenv_(&c__1, "DORGLQ",
  552. " ", m, n, m, &c_n1);
  553. wrkbl = max(i__2,i__3);
  554. /* Computing MAX */
  555. i__2 = wrkbl, i__3 = *m * 3 + (*m << 1) * _starpu_ilaenv_(&c__1,
  556. "DGEBRD", " ", m, m, &c_n1, &c_n1);
  557. wrkbl = max(i__2,i__3);
  558. /* Computing MAX */
  559. i__2 = wrkbl, i__3 = *m * 3 + (*m - 1) * _starpu_ilaenv_(&c__1,
  560. "DORGBR", "P", m, m, m, &c_n1);
  561. wrkbl = max(i__2,i__3);
  562. /* Computing MAX */
  563. i__2 = wrkbl, i__3 = *m * 3 + *m * _starpu_ilaenv_(&c__1, "DORGBR"
  564. , "Q", m, m, m, &c_n1);
  565. wrkbl = max(i__2,i__3);
  566. wrkbl = max(wrkbl,bdspac);
  567. /* Computing MAX */
  568. i__2 = *m * *m + wrkbl, i__3 = *m * *m + *m * *n + *m;
  569. maxwrk = max(i__2,i__3);
  570. /* Computing MAX */
  571. i__2 = *m * 3 + *n;
  572. minwrk = max(i__2,bdspac);
  573. } else if (wntvs && wntun) {
  574. /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */
  575. wrkbl = *m + *m * _starpu_ilaenv_(&c__1, "DGELQF", " ", m, n, &
  576. c_n1, &c_n1);
  577. /* Computing MAX */
  578. i__2 = wrkbl, i__3 = *m + *m * _starpu_ilaenv_(&c__1, "DORGLQ",
  579. " ", m, n, m, &c_n1);
  580. wrkbl = max(i__2,i__3);
  581. /* Computing MAX */
  582. i__2 = wrkbl, i__3 = *m * 3 + (*m << 1) * _starpu_ilaenv_(&c__1,
  583. "DGEBRD", " ", m, m, &c_n1, &c_n1);
  584. wrkbl = max(i__2,i__3);
  585. /* Computing MAX */
  586. i__2 = wrkbl, i__3 = *m * 3 + (*m - 1) * _starpu_ilaenv_(&c__1,
  587. "DORGBR", "P", m, m, m, &c_n1);
  588. wrkbl = max(i__2,i__3);
  589. wrkbl = max(wrkbl,bdspac);
  590. maxwrk = *m * *m + wrkbl;
  591. /* Computing MAX */
  592. i__2 = *m * 3 + *n;
  593. minwrk = max(i__2,bdspac);
  594. } else if (wntvs && wntuo) {
  595. /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */
  596. wrkbl = *m + *m * _starpu_ilaenv_(&c__1, "DGELQF", " ", m, n, &
  597. c_n1, &c_n1);
  598. /* Computing MAX */
  599. i__2 = wrkbl, i__3 = *m + *m * _starpu_ilaenv_(&c__1, "DORGLQ",
  600. " ", m, n, m, &c_n1);
  601. wrkbl = max(i__2,i__3);
  602. /* Computing MAX */
  603. i__2 = wrkbl, i__3 = *m * 3 + (*m << 1) * _starpu_ilaenv_(&c__1,
  604. "DGEBRD", " ", m, m, &c_n1, &c_n1);
  605. wrkbl = max(i__2,i__3);
  606. /* Computing MAX */
  607. i__2 = wrkbl, i__3 = *m * 3 + (*m - 1) * _starpu_ilaenv_(&c__1,
  608. "DORGBR", "P", m, m, m, &c_n1);
  609. wrkbl = max(i__2,i__3);
  610. /* Computing MAX */
  611. i__2 = wrkbl, i__3 = *m * 3 + *m * _starpu_ilaenv_(&c__1, "DORGBR"
  612. , "Q", m, m, m, &c_n1);
  613. wrkbl = max(i__2,i__3);
  614. wrkbl = max(wrkbl,bdspac);
  615. maxwrk = (*m << 1) * *m + wrkbl;
  616. /* Computing MAX */
  617. i__2 = *m * 3 + *n;
  618. minwrk = max(i__2,bdspac);
  619. } else if (wntvs && wntuas) {
  620. /* Path 6t(N much larger than M, JOBU='S' or 'A', */
  621. /* JOBVT='S') */
  622. wrkbl = *m + *m * _starpu_ilaenv_(&c__1, "DGELQF", " ", m, n, &
  623. c_n1, &c_n1);
  624. /* Computing MAX */
  625. i__2 = wrkbl, i__3 = *m + *m * _starpu_ilaenv_(&c__1, "DORGLQ",
  626. " ", m, n, m, &c_n1);
  627. wrkbl = max(i__2,i__3);
  628. /* Computing MAX */
  629. i__2 = wrkbl, i__3 = *m * 3 + (*m << 1) * _starpu_ilaenv_(&c__1,
  630. "DGEBRD", " ", m, m, &c_n1, &c_n1);
  631. wrkbl = max(i__2,i__3);
  632. /* Computing MAX */
  633. i__2 = wrkbl, i__3 = *m * 3 + (*m - 1) * _starpu_ilaenv_(&c__1,
  634. "DORGBR", "P", m, m, m, &c_n1);
  635. wrkbl = max(i__2,i__3);
  636. /* Computing MAX */
  637. i__2 = wrkbl, i__3 = *m * 3 + *m * _starpu_ilaenv_(&c__1, "DORGBR"
  638. , "Q", m, m, m, &c_n1);
  639. wrkbl = max(i__2,i__3);
  640. wrkbl = max(wrkbl,bdspac);
  641. maxwrk = *m * *m + wrkbl;
  642. /* Computing MAX */
  643. i__2 = *m * 3 + *n;
  644. minwrk = max(i__2,bdspac);
  645. } else if (wntva && wntun) {
  646. /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */
  647. wrkbl = *m + *m * _starpu_ilaenv_(&c__1, "DGELQF", " ", m, n, &
  648. c_n1, &c_n1);
  649. /* Computing MAX */
  650. i__2 = wrkbl, i__3 = *m + *n * _starpu_ilaenv_(&c__1, "DORGLQ",
  651. " ", n, n, m, &c_n1);
  652. wrkbl = max(i__2,i__3);
  653. /* Computing MAX */
  654. i__2 = wrkbl, i__3 = *m * 3 + (*m << 1) * _starpu_ilaenv_(&c__1,
  655. "DGEBRD", " ", m, m, &c_n1, &c_n1);
  656. wrkbl = max(i__2,i__3);
  657. /* Computing MAX */
  658. i__2 = wrkbl, i__3 = *m * 3 + (*m - 1) * _starpu_ilaenv_(&c__1,
  659. "DORGBR", "P", m, m, m, &c_n1);
  660. wrkbl = max(i__2,i__3);
  661. wrkbl = max(wrkbl,bdspac);
  662. maxwrk = *m * *m + wrkbl;
  663. /* Computing MAX */
  664. i__2 = *m * 3 + *n;
  665. minwrk = max(i__2,bdspac);
  666. } else if (wntva && wntuo) {
  667. /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */
  668. wrkbl = *m + *m * _starpu_ilaenv_(&c__1, "DGELQF", " ", m, n, &
  669. c_n1, &c_n1);
  670. /* Computing MAX */
  671. i__2 = wrkbl, i__3 = *m + *n * _starpu_ilaenv_(&c__1, "DORGLQ",
  672. " ", n, n, m, &c_n1);
  673. wrkbl = max(i__2,i__3);
  674. /* Computing MAX */
  675. i__2 = wrkbl, i__3 = *m * 3 + (*m << 1) * _starpu_ilaenv_(&c__1,
  676. "DGEBRD", " ", m, m, &c_n1, &c_n1);
  677. wrkbl = max(i__2,i__3);
  678. /* Computing MAX */
  679. i__2 = wrkbl, i__3 = *m * 3 + (*m - 1) * _starpu_ilaenv_(&c__1,
  680. "DORGBR", "P", m, m, m, &c_n1);
  681. wrkbl = max(i__2,i__3);
  682. /* Computing MAX */
  683. i__2 = wrkbl, i__3 = *m * 3 + *m * _starpu_ilaenv_(&c__1, "DORGBR"
  684. , "Q", m, m, m, &c_n1);
  685. wrkbl = max(i__2,i__3);
  686. wrkbl = max(wrkbl,bdspac);
  687. maxwrk = (*m << 1) * *m + wrkbl;
  688. /* Computing MAX */
  689. i__2 = *m * 3 + *n;
  690. minwrk = max(i__2,bdspac);
  691. } else if (wntva && wntuas) {
  692. /* Path 9t(N much larger than M, JOBU='S' or 'A', */
  693. /* JOBVT='A') */
  694. wrkbl = *m + *m * _starpu_ilaenv_(&c__1, "DGELQF", " ", m, n, &
  695. c_n1, &c_n1);
  696. /* Computing MAX */
  697. i__2 = wrkbl, i__3 = *m + *n * _starpu_ilaenv_(&c__1, "DORGLQ",
  698. " ", n, n, m, &c_n1);
  699. wrkbl = max(i__2,i__3);
  700. /* Computing MAX */
  701. i__2 = wrkbl, i__3 = *m * 3 + (*m << 1) * _starpu_ilaenv_(&c__1,
  702. "DGEBRD", " ", m, m, &c_n1, &c_n1);
  703. wrkbl = max(i__2,i__3);
  704. /* Computing MAX */
  705. i__2 = wrkbl, i__3 = *m * 3 + (*m - 1) * _starpu_ilaenv_(&c__1,
  706. "DORGBR", "P", m, m, m, &c_n1);
  707. wrkbl = max(i__2,i__3);
  708. /* Computing MAX */
  709. i__2 = wrkbl, i__3 = *m * 3 + *m * _starpu_ilaenv_(&c__1, "DORGBR"
  710. , "Q", m, m, m, &c_n1);
  711. wrkbl = max(i__2,i__3);
  712. wrkbl = max(wrkbl,bdspac);
  713. maxwrk = *m * *m + wrkbl;
  714. /* Computing MAX */
  715. i__2 = *m * 3 + *n;
  716. minwrk = max(i__2,bdspac);
  717. }
  718. } else {
  719. /* Path 10t(N greater than M, but not much larger) */
  720. maxwrk = *m * 3 + (*m + *n) * _starpu_ilaenv_(&c__1, "DGEBRD", " ", m,
  721. n, &c_n1, &c_n1);
  722. if (wntvs || wntvo) {
  723. /* Computing MAX */
  724. i__2 = maxwrk, i__3 = *m * 3 + *m * _starpu_ilaenv_(&c__1, "DORG"
  725. "BR", "P", m, n, m, &c_n1);
  726. maxwrk = max(i__2,i__3);
  727. }
  728. if (wntva) {
  729. /* Computing MAX */
  730. i__2 = maxwrk, i__3 = *m * 3 + *n * _starpu_ilaenv_(&c__1, "DORG"
  731. "BR", "P", n, n, m, &c_n1);
  732. maxwrk = max(i__2,i__3);
  733. }
  734. if (! wntun) {
  735. /* Computing MAX */
  736. i__2 = maxwrk, i__3 = *m * 3 + (*m - 1) * _starpu_ilaenv_(&c__1,
  737. "DORGBR", "Q", m, m, m, &c_n1);
  738. maxwrk = max(i__2,i__3);
  739. }
  740. maxwrk = max(maxwrk,bdspac);
  741. /* Computing MAX */
  742. i__2 = *m * 3 + *n;
  743. minwrk = max(i__2,bdspac);
  744. }
  745. }
  746. maxwrk = max(maxwrk,minwrk);
  747. work[1] = (doublereal) maxwrk;
  748. if (*lwork < minwrk && ! lquery) {
  749. *info = -13;
  750. }
  751. }
  752. if (*info != 0) {
  753. i__2 = -(*info);
  754. _starpu_xerbla_("DGESVD", &i__2);
  755. return 0;
  756. } else if (lquery) {
  757. return 0;
  758. }
  759. /* Quick return if possible */
  760. if (*m == 0 || *n == 0) {
  761. return 0;
  762. }
  763. /* Get machine constants */
  764. eps = _starpu_dlamch_("P");
  765. smlnum = sqrt(_starpu_dlamch_("S")) / eps;
  766. bignum = 1. / smlnum;
  767. /* Scale A if max element outside range [SMLNUM,BIGNUM] */
  768. anrm = _starpu_dlange_("M", m, n, &a[a_offset], lda, dum);
  769. iscl = 0;
  770. if (anrm > 0. && anrm < smlnum) {
  771. iscl = 1;
  772. _starpu_dlascl_("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &
  773. ierr);
  774. } else if (anrm > bignum) {
  775. iscl = 1;
  776. _starpu_dlascl_("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda, &
  777. ierr);
  778. }
  779. if (*m >= *n) {
  780. /* A has at least as many rows as columns. If A has sufficiently */
  781. /* more rows than columns, first reduce using the QR */
  782. /* decomposition (if sufficient workspace available) */
  783. if (*m >= mnthr) {
  784. if (wntun) {
  785. /* Path 1 (M much larger than N, JOBU='N') */
  786. /* No left singular vectors to be computed */
  787. itau = 1;
  788. iwork = itau + *n;
  789. /* Compute A=Q*R */
  790. /* (Workspace: need 2*N, prefer N+N*NB) */
  791. i__2 = *lwork - iwork + 1;
  792. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &
  793. i__2, &ierr);
  794. /* Zero out below R */
  795. i__2 = *n - 1;
  796. i__3 = *n - 1;
  797. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &a[a_dim1 + 2],
  798. lda);
  799. ie = 1;
  800. itauq = ie + *n;
  801. itaup = itauq + *n;
  802. iwork = itaup + *n;
  803. /* Bidiagonalize R in A */
  804. /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  805. i__2 = *lwork - iwork + 1;
  806. _starpu_dgebrd_(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[
  807. itauq], &work[itaup], &work[iwork], &i__2, &ierr);
  808. ncvt = 0;
  809. if (wntvo || wntvas) {
  810. /* If right singular vectors desired, generate P'. */
  811. /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  812. i__2 = *lwork - iwork + 1;
  813. _starpu_dorgbr_("P", n, n, n, &a[a_offset], lda, &work[itaup], &
  814. work[iwork], &i__2, &ierr);
  815. ncvt = *n;
  816. }
  817. iwork = ie + *n;
  818. /* Perform bidiagonal QR iteration, computing right */
  819. /* singular vectors of A in A if desired */
  820. /* (Workspace: need BDSPAC) */
  821. _starpu_dbdsqr_("U", n, &ncvt, &c__0, &c__0, &s[1], &work[ie], &a[
  822. a_offset], lda, dum, &c__1, dum, &c__1, &work[iwork],
  823. info);
  824. /* If right singular vectors desired in VT, copy them there */
  825. if (wntvas) {
  826. _starpu_dlacpy_("F", n, n, &a[a_offset], lda, &vt[vt_offset],
  827. ldvt);
  828. }
  829. } else if (wntuo && wntvn) {
  830. /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */
  831. /* N left singular vectors to be overwritten on A and */
  832. /* no right singular vectors to be computed */
  833. /* Computing MAX */
  834. i__2 = *n << 2;
  835. if (*lwork >= *n * *n + max(i__2,bdspac)) {
  836. /* Sufficient workspace for a fast algorithm */
  837. ir = 1;
  838. /* Computing MAX */
  839. i__2 = wrkbl, i__3 = *lda * *n + *n;
  840. if (*lwork >= max(i__2,i__3) + *lda * *n) {
  841. /* WORK(IU) is LDA by N, WORK(IR) is LDA by N */
  842. ldwrku = *lda;
  843. ldwrkr = *lda;
  844. } else /* if(complicated condition) */ {
  845. /* Computing MAX */
  846. i__2 = wrkbl, i__3 = *lda * *n + *n;
  847. if (*lwork >= max(i__2,i__3) + *n * *n) {
  848. /* WORK(IU) is LDA by N, WORK(IR) is N by N */
  849. ldwrku = *lda;
  850. ldwrkr = *n;
  851. } else {
  852. /* WORK(IU) is LDWRKU by N, WORK(IR) is N by N */
  853. ldwrku = (*lwork - *n * *n - *n) / *n;
  854. ldwrkr = *n;
  855. }
  856. }
  857. itau = ir + ldwrkr * *n;
  858. iwork = itau + *n;
  859. /* Compute A=Q*R */
  860. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  861. i__2 = *lwork - iwork + 1;
  862. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  863. , &i__2, &ierr);
  864. /* Copy R to WORK(IR) and zero out below it */
  865. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
  866. i__2 = *n - 1;
  867. i__3 = *n - 1;
  868. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &work[ir + 1]
  869. , &ldwrkr);
  870. /* Generate Q in A */
  871. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  872. i__2 = *lwork - iwork + 1;
  873. _starpu_dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[
  874. iwork], &i__2, &ierr);
  875. ie = itau;
  876. itauq = ie + *n;
  877. itaup = itauq + *n;
  878. iwork = itaup + *n;
  879. /* Bidiagonalize R in WORK(IR) */
  880. /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  881. i__2 = *lwork - iwork + 1;
  882. _starpu_dgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[
  883. itauq], &work[itaup], &work[iwork], &i__2, &ierr);
  884. /* Generate left vectors bidiagonalizing R */
  885. /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  886. i__2 = *lwork - iwork + 1;
  887. _starpu_dorgbr_("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &
  888. work[iwork], &i__2, &ierr);
  889. iwork = ie + *n;
  890. /* Perform bidiagonal QR iteration, computing left */
  891. /* singular vectors of R in WORK(IR) */
  892. /* (Workspace: need N*N+BDSPAC) */
  893. _starpu_dbdsqr_("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &
  894. c__1, &work[ir], &ldwrkr, dum, &c__1, &work[iwork]
  895. , info);
  896. iu = ie + *n;
  897. /* Multiply Q in A by left singular vectors of R in */
  898. /* WORK(IR), storing result in WORK(IU) and copying to A */
  899. /* (Workspace: need N*N+2*N, prefer N*N+M*N+N) */
  900. i__2 = *m;
  901. i__3 = ldwrku;
  902. for (i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
  903. i__3) {
  904. /* Computing MIN */
  905. i__4 = *m - i__ + 1;
  906. chunk = min(i__4,ldwrku);
  907. _starpu_dgemm_("N", "N", &chunk, n, n, &c_b443, &a[i__ +
  908. a_dim1], lda, &work[ir], &ldwrkr, &c_b421, &
  909. work[iu], &ldwrku);
  910. _starpu_dlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ +
  911. a_dim1], lda);
  912. /* L10: */
  913. }
  914. } else {
  915. /* Insufficient workspace for a fast algorithm */
  916. ie = 1;
  917. itauq = ie + *n;
  918. itaup = itauq + *n;
  919. iwork = itaup + *n;
  920. /* Bidiagonalize A */
  921. /* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) */
  922. i__3 = *lwork - iwork + 1;
  923. _starpu_dgebrd_(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[
  924. itauq], &work[itaup], &work[iwork], &i__3, &ierr);
  925. /* Generate left vectors bidiagonalizing A */
  926. /* (Workspace: need 4*N, prefer 3*N+N*NB) */
  927. i__3 = *lwork - iwork + 1;
  928. _starpu_dorgbr_("Q", m, n, n, &a[a_offset], lda, &work[itauq], &
  929. work[iwork], &i__3, &ierr);
  930. iwork = ie + *n;
  931. /* Perform bidiagonal QR iteration, computing left */
  932. /* singular vectors of A in A */
  933. /* (Workspace: need BDSPAC) */
  934. _starpu_dbdsqr_("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &
  935. c__1, &a[a_offset], lda, dum, &c__1, &work[iwork],
  936. info);
  937. }
  938. } else if (wntuo && wntvas) {
  939. /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A') */
  940. /* N left singular vectors to be overwritten on A and */
  941. /* N right singular vectors to be computed in VT */
  942. /* Computing MAX */
  943. i__3 = *n << 2;
  944. if (*lwork >= *n * *n + max(i__3,bdspac)) {
  945. /* Sufficient workspace for a fast algorithm */
  946. ir = 1;
  947. /* Computing MAX */
  948. i__3 = wrkbl, i__2 = *lda * *n + *n;
  949. if (*lwork >= max(i__3,i__2) + *lda * *n) {
  950. /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */
  951. ldwrku = *lda;
  952. ldwrkr = *lda;
  953. } else /* if(complicated condition) */ {
  954. /* Computing MAX */
  955. i__3 = wrkbl, i__2 = *lda * *n + *n;
  956. if (*lwork >= max(i__3,i__2) + *n * *n) {
  957. /* WORK(IU) is LDA by N and WORK(IR) is N by N */
  958. ldwrku = *lda;
  959. ldwrkr = *n;
  960. } else {
  961. /* WORK(IU) is LDWRKU by N and WORK(IR) is N by N */
  962. ldwrku = (*lwork - *n * *n - *n) / *n;
  963. ldwrkr = *n;
  964. }
  965. }
  966. itau = ir + ldwrkr * *n;
  967. iwork = itau + *n;
  968. /* Compute A=Q*R */
  969. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  970. i__3 = *lwork - iwork + 1;
  971. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  972. , &i__3, &ierr);
  973. /* Copy R to VT, zeroing out below it */
  974. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset],
  975. ldvt);
  976. if (*n > 1) {
  977. i__3 = *n - 1;
  978. i__2 = *n - 1;
  979. _starpu_dlaset_("L", &i__3, &i__2, &c_b421, &c_b421, &vt[
  980. vt_dim1 + 2], ldvt);
  981. }
  982. /* Generate Q in A */
  983. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  984. i__3 = *lwork - iwork + 1;
  985. _starpu_dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[
  986. iwork], &i__3, &ierr);
  987. ie = itau;
  988. itauq = ie + *n;
  989. itaup = itauq + *n;
  990. iwork = itaup + *n;
  991. /* Bidiagonalize R in VT, copying result to WORK(IR) */
  992. /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  993. i__3 = *lwork - iwork + 1;
  994. _starpu_dgebrd_(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], &
  995. work[itauq], &work[itaup], &work[iwork], &i__3, &
  996. ierr);
  997. _starpu_dlacpy_("L", n, n, &vt[vt_offset], ldvt, &work[ir], &
  998. ldwrkr);
  999. /* Generate left vectors bidiagonalizing R in WORK(IR) */
  1000. /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  1001. i__3 = *lwork - iwork + 1;
  1002. _starpu_dorgbr_("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &
  1003. work[iwork], &i__3, &ierr);
  1004. /* Generate right vectors bidiagonalizing R in VT */
  1005. /* (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB) */
  1006. i__3 = *lwork - iwork + 1;
  1007. _starpu_dorgbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup],
  1008. &work[iwork], &i__3, &ierr);
  1009. iwork = ie + *n;
  1010. /* Perform bidiagonal QR iteration, computing left */
  1011. /* singular vectors of R in WORK(IR) and computing right */
  1012. /* singular vectors of R in VT */
  1013. /* (Workspace: need N*N+BDSPAC) */
  1014. _starpu_dbdsqr_("U", n, n, n, &c__0, &s[1], &work[ie], &vt[
  1015. vt_offset], ldvt, &work[ir], &ldwrkr, dum, &c__1,
  1016. &work[iwork], info);
  1017. iu = ie + *n;
  1018. /* Multiply Q in A by left singular vectors of R in */
  1019. /* WORK(IR), storing result in WORK(IU) and copying to A */
  1020. /* (Workspace: need N*N+2*N, prefer N*N+M*N+N) */
  1021. i__3 = *m;
  1022. i__2 = ldwrku;
  1023. for (i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ +=
  1024. i__2) {
  1025. /* Computing MIN */
  1026. i__4 = *m - i__ + 1;
  1027. chunk = min(i__4,ldwrku);
  1028. _starpu_dgemm_("N", "N", &chunk, n, n, &c_b443, &a[i__ +
  1029. a_dim1], lda, &work[ir], &ldwrkr, &c_b421, &
  1030. work[iu], &ldwrku);
  1031. _starpu_dlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ +
  1032. a_dim1], lda);
  1033. /* L20: */
  1034. }
  1035. } else {
  1036. /* Insufficient workspace for a fast algorithm */
  1037. itau = 1;
  1038. iwork = itau + *n;
  1039. /* Compute A=Q*R */
  1040. /* (Workspace: need 2*N, prefer N+N*NB) */
  1041. i__2 = *lwork - iwork + 1;
  1042. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  1043. , &i__2, &ierr);
  1044. /* Copy R to VT, zeroing out below it */
  1045. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset],
  1046. ldvt);
  1047. if (*n > 1) {
  1048. i__2 = *n - 1;
  1049. i__3 = *n - 1;
  1050. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &vt[
  1051. vt_dim1 + 2], ldvt);
  1052. }
  1053. /* Generate Q in A */
  1054. /* (Workspace: need 2*N, prefer N+N*NB) */
  1055. i__2 = *lwork - iwork + 1;
  1056. _starpu_dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[
  1057. iwork], &i__2, &ierr);
  1058. ie = itau;
  1059. itauq = ie + *n;
  1060. itaup = itauq + *n;
  1061. iwork = itaup + *n;
  1062. /* Bidiagonalize R in VT */
  1063. /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  1064. i__2 = *lwork - iwork + 1;
  1065. _starpu_dgebrd_(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], &
  1066. work[itauq], &work[itaup], &work[iwork], &i__2, &
  1067. ierr);
  1068. /* Multiply Q in A by left vectors bidiagonalizing R */
  1069. /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  1070. i__2 = *lwork - iwork + 1;
  1071. _starpu_dormbr_("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, &
  1072. work[itauq], &a[a_offset], lda, &work[iwork], &
  1073. i__2, &ierr);
  1074. /* Generate right vectors bidiagonalizing R in VT */
  1075. /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  1076. i__2 = *lwork - iwork + 1;
  1077. _starpu_dorgbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup],
  1078. &work[iwork], &i__2, &ierr);
  1079. iwork = ie + *n;
  1080. /* Perform bidiagonal QR iteration, computing left */
  1081. /* singular vectors of A in A and computing right */
  1082. /* singular vectors of A in VT */
  1083. /* (Workspace: need BDSPAC) */
  1084. _starpu_dbdsqr_("U", n, n, m, &c__0, &s[1], &work[ie], &vt[
  1085. vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, &
  1086. work[iwork], info);
  1087. }
  1088. } else if (wntus) {
  1089. if (wntvn) {
  1090. /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */
  1091. /* N left singular vectors to be computed in U and */
  1092. /* no right singular vectors to be computed */
  1093. /* Computing MAX */
  1094. i__2 = *n << 2;
  1095. if (*lwork >= *n * *n + max(i__2,bdspac)) {
  1096. /* Sufficient workspace for a fast algorithm */
  1097. ir = 1;
  1098. if (*lwork >= wrkbl + *lda * *n) {
  1099. /* WORK(IR) is LDA by N */
  1100. ldwrkr = *lda;
  1101. } else {
  1102. /* WORK(IR) is N by N */
  1103. ldwrkr = *n;
  1104. }
  1105. itau = ir + ldwrkr * *n;
  1106. iwork = itau + *n;
  1107. /* Compute A=Q*R */
  1108. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1109. i__2 = *lwork - iwork + 1;
  1110. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1111. iwork], &i__2, &ierr);
  1112. /* Copy R to WORK(IR), zeroing out below it */
  1113. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &
  1114. ldwrkr);
  1115. i__2 = *n - 1;
  1116. i__3 = *n - 1;
  1117. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &work[ir
  1118. + 1], &ldwrkr);
  1119. /* Generate Q in A */
  1120. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1121. i__2 = *lwork - iwork + 1;
  1122. _starpu_dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &
  1123. work[iwork], &i__2, &ierr);
  1124. ie = itau;
  1125. itauq = ie + *n;
  1126. itaup = itauq + *n;
  1127. iwork = itaup + *n;
  1128. /* Bidiagonalize R in WORK(IR) */
  1129. /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  1130. i__2 = *lwork - iwork + 1;
  1131. _starpu_dgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &
  1132. work[itauq], &work[itaup], &work[iwork], &
  1133. i__2, &ierr);
  1134. /* Generate left vectors bidiagonalizing R in WORK(IR) */
  1135. /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  1136. i__2 = *lwork - iwork + 1;
  1137. _starpu_dorgbr_("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq]
  1138. , &work[iwork], &i__2, &ierr);
  1139. iwork = ie + *n;
  1140. /* Perform bidiagonal QR iteration, computing left */
  1141. /* singular vectors of R in WORK(IR) */
  1142. /* (Workspace: need N*N+BDSPAC) */
  1143. _starpu_dbdsqr_("U", n, &c__0, n, &c__0, &s[1], &work[ie],
  1144. dum, &c__1, &work[ir], &ldwrkr, dum, &c__1, &
  1145. work[iwork], info);
  1146. /* Multiply Q in A by left singular vectors of R in */
  1147. /* WORK(IR), storing result in U */
  1148. /* (Workspace: need N*N) */
  1149. _starpu_dgemm_("N", "N", m, n, n, &c_b443, &a[a_offset], lda,
  1150. &work[ir], &ldwrkr, &c_b421, &u[u_offset],
  1151. ldu);
  1152. } else {
  1153. /* Insufficient workspace for a fast algorithm */
  1154. itau = 1;
  1155. iwork = itau + *n;
  1156. /* Compute A=Q*R, copying result to U */
  1157. /* (Workspace: need 2*N, prefer N+N*NB) */
  1158. i__2 = *lwork - iwork + 1;
  1159. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1160. iwork], &i__2, &ierr);
  1161. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1162. ldu);
  1163. /* Generate Q in U */
  1164. /* (Workspace: need 2*N, prefer N+N*NB) */
  1165. i__2 = *lwork - iwork + 1;
  1166. _starpu_dorgqr_(m, n, n, &u[u_offset], ldu, &work[itau], &
  1167. work[iwork], &i__2, &ierr);
  1168. ie = itau;
  1169. itauq = ie + *n;
  1170. itaup = itauq + *n;
  1171. iwork = itaup + *n;
  1172. /* Zero out below R in A */
  1173. i__2 = *n - 1;
  1174. i__3 = *n - 1;
  1175. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &a[
  1176. a_dim1 + 2], lda);
  1177. /* Bidiagonalize R in A */
  1178. /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  1179. i__2 = *lwork - iwork + 1;
  1180. _starpu_dgebrd_(n, n, &a[a_offset], lda, &s[1], &work[ie], &
  1181. work[itauq], &work[itaup], &work[iwork], &
  1182. i__2, &ierr);
  1183. /* Multiply Q in U by left vectors bidiagonalizing R */
  1184. /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  1185. i__2 = *lwork - iwork + 1;
  1186. _starpu_dormbr_("Q", "R", "N", m, n, n, &a[a_offset], lda, &
  1187. work[itauq], &u[u_offset], ldu, &work[iwork],
  1188. &i__2, &ierr)
  1189. ;
  1190. iwork = ie + *n;
  1191. /* Perform bidiagonal QR iteration, computing left */
  1192. /* singular vectors of A in U */
  1193. /* (Workspace: need BDSPAC) */
  1194. _starpu_dbdsqr_("U", n, &c__0, m, &c__0, &s[1], &work[ie],
  1195. dum, &c__1, &u[u_offset], ldu, dum, &c__1, &
  1196. work[iwork], info);
  1197. }
  1198. } else if (wntvo) {
  1199. /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */
  1200. /* N left singular vectors to be computed in U and */
  1201. /* N right singular vectors to be overwritten on A */
  1202. /* Computing MAX */
  1203. i__2 = *n << 2;
  1204. if (*lwork >= (*n << 1) * *n + max(i__2,bdspac)) {
  1205. /* Sufficient workspace for a fast algorithm */
  1206. iu = 1;
  1207. if (*lwork >= wrkbl + (*lda << 1) * *n) {
  1208. /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */
  1209. ldwrku = *lda;
  1210. ir = iu + ldwrku * *n;
  1211. ldwrkr = *lda;
  1212. } else if (*lwork >= wrkbl + (*lda + *n) * *n) {
  1213. /* WORK(IU) is LDA by N and WORK(IR) is N by N */
  1214. ldwrku = *lda;
  1215. ir = iu + ldwrku * *n;
  1216. ldwrkr = *n;
  1217. } else {
  1218. /* WORK(IU) is N by N and WORK(IR) is N by N */
  1219. ldwrku = *n;
  1220. ir = iu + ldwrku * *n;
  1221. ldwrkr = *n;
  1222. }
  1223. itau = ir + ldwrkr * *n;
  1224. iwork = itau + *n;
  1225. /* Compute A=Q*R */
  1226. /* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */
  1227. i__2 = *lwork - iwork + 1;
  1228. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1229. iwork], &i__2, &ierr);
  1230. /* Copy R to WORK(IU), zeroing out below it */
  1231. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &
  1232. ldwrku);
  1233. i__2 = *n - 1;
  1234. i__3 = *n - 1;
  1235. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &work[iu
  1236. + 1], &ldwrku);
  1237. /* Generate Q in A */
  1238. /* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */
  1239. i__2 = *lwork - iwork + 1;
  1240. _starpu_dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &
  1241. work[iwork], &i__2, &ierr);
  1242. ie = itau;
  1243. itauq = ie + *n;
  1244. itaup = itauq + *n;
  1245. iwork = itaup + *n;
  1246. /* Bidiagonalize R in WORK(IU), copying result to */
  1247. /* WORK(IR) */
  1248. /* (Workspace: need 2*N*N+4*N, */
  1249. /* prefer 2*N*N+3*N+2*N*NB) */
  1250. i__2 = *lwork - iwork + 1;
  1251. _starpu_dgebrd_(n, n, &work[iu], &ldwrku, &s[1], &work[ie], &
  1252. work[itauq], &work[itaup], &work[iwork], &
  1253. i__2, &ierr);
  1254. _starpu_dlacpy_("U", n, n, &work[iu], &ldwrku, &work[ir], &
  1255. ldwrkr);
  1256. /* Generate left bidiagonalizing vectors in WORK(IU) */
  1257. /* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB) */
  1258. i__2 = *lwork - iwork + 1;
  1259. _starpu_dorgbr_("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
  1260. , &work[iwork], &i__2, &ierr);
  1261. /* Generate right bidiagonalizing vectors in WORK(IR) */
  1262. /* (Workspace: need 2*N*N+4*N-1, */
  1263. /* prefer 2*N*N+3*N+(N-1)*NB) */
  1264. i__2 = *lwork - iwork + 1;
  1265. _starpu_dorgbr_("P", n, n, n, &work[ir], &ldwrkr, &work[itaup]
  1266. , &work[iwork], &i__2, &ierr);
  1267. iwork = ie + *n;
  1268. /* Perform bidiagonal QR iteration, computing left */
  1269. /* singular vectors of R in WORK(IU) and computing */
  1270. /* right singular vectors of R in WORK(IR) */
  1271. /* (Workspace: need 2*N*N+BDSPAC) */
  1272. _starpu_dbdsqr_("U", n, n, n, &c__0, &s[1], &work[ie], &work[
  1273. ir], &ldwrkr, &work[iu], &ldwrku, dum, &c__1,
  1274. &work[iwork], info);
  1275. /* Multiply Q in A by left singular vectors of R in */
  1276. /* WORK(IU), storing result in U */
  1277. /* (Workspace: need N*N) */
  1278. _starpu_dgemm_("N", "N", m, n, n, &c_b443, &a[a_offset], lda,
  1279. &work[iu], &ldwrku, &c_b421, &u[u_offset],
  1280. ldu);
  1281. /* Copy right singular vectors of R to A */
  1282. /* (Workspace: need N*N) */
  1283. _starpu_dlacpy_("F", n, n, &work[ir], &ldwrkr, &a[a_offset],
  1284. lda);
  1285. } else {
  1286. /* Insufficient workspace for a fast algorithm */
  1287. itau = 1;
  1288. iwork = itau + *n;
  1289. /* Compute A=Q*R, copying result to U */
  1290. /* (Workspace: need 2*N, prefer N+N*NB) */
  1291. i__2 = *lwork - iwork + 1;
  1292. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1293. iwork], &i__2, &ierr);
  1294. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1295. ldu);
  1296. /* Generate Q in U */
  1297. /* (Workspace: need 2*N, prefer N+N*NB) */
  1298. i__2 = *lwork - iwork + 1;
  1299. _starpu_dorgqr_(m, n, n, &u[u_offset], ldu, &work[itau], &
  1300. work[iwork], &i__2, &ierr);
  1301. ie = itau;
  1302. itauq = ie + *n;
  1303. itaup = itauq + *n;
  1304. iwork = itaup + *n;
  1305. /* Zero out below R in A */
  1306. i__2 = *n - 1;
  1307. i__3 = *n - 1;
  1308. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &a[
  1309. a_dim1 + 2], lda);
  1310. /* Bidiagonalize R in A */
  1311. /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  1312. i__2 = *lwork - iwork + 1;
  1313. _starpu_dgebrd_(n, n, &a[a_offset], lda, &s[1], &work[ie], &
  1314. work[itauq], &work[itaup], &work[iwork], &
  1315. i__2, &ierr);
  1316. /* Multiply Q in U by left vectors bidiagonalizing R */
  1317. /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  1318. i__2 = *lwork - iwork + 1;
  1319. _starpu_dormbr_("Q", "R", "N", m, n, n, &a[a_offset], lda, &
  1320. work[itauq], &u[u_offset], ldu, &work[iwork],
  1321. &i__2, &ierr)
  1322. ;
  1323. /* Generate right vectors bidiagonalizing R in A */
  1324. /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  1325. i__2 = *lwork - iwork + 1;
  1326. _starpu_dorgbr_("P", n, n, n, &a[a_offset], lda, &work[itaup],
  1327. &work[iwork], &i__2, &ierr);
  1328. iwork = ie + *n;
  1329. /* Perform bidiagonal QR iteration, computing left */
  1330. /* singular vectors of A in U and computing right */
  1331. /* singular vectors of A in A */
  1332. /* (Workspace: need BDSPAC) */
  1333. _starpu_dbdsqr_("U", n, n, m, &c__0, &s[1], &work[ie], &a[
  1334. a_offset], lda, &u[u_offset], ldu, dum, &c__1,
  1335. &work[iwork], info);
  1336. }
  1337. } else if (wntvas) {
  1338. /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' */
  1339. /* or 'A') */
  1340. /* N left singular vectors to be computed in U and */
  1341. /* N right singular vectors to be computed in VT */
  1342. /* Computing MAX */
  1343. i__2 = *n << 2;
  1344. if (*lwork >= *n * *n + max(i__2,bdspac)) {
  1345. /* Sufficient workspace for a fast algorithm */
  1346. iu = 1;
  1347. if (*lwork >= wrkbl + *lda * *n) {
  1348. /* WORK(IU) is LDA by N */
  1349. ldwrku = *lda;
  1350. } else {
  1351. /* WORK(IU) is N by N */
  1352. ldwrku = *n;
  1353. }
  1354. itau = iu + ldwrku * *n;
  1355. iwork = itau + *n;
  1356. /* Compute A=Q*R */
  1357. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1358. i__2 = *lwork - iwork + 1;
  1359. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1360. iwork], &i__2, &ierr);
  1361. /* Copy R to WORK(IU), zeroing out below it */
  1362. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &
  1363. ldwrku);
  1364. i__2 = *n - 1;
  1365. i__3 = *n - 1;
  1366. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &work[iu
  1367. + 1], &ldwrku);
  1368. /* Generate Q in A */
  1369. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1370. i__2 = *lwork - iwork + 1;
  1371. _starpu_dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &
  1372. work[iwork], &i__2, &ierr);
  1373. ie = itau;
  1374. itauq = ie + *n;
  1375. itaup = itauq + *n;
  1376. iwork = itaup + *n;
  1377. /* Bidiagonalize R in WORK(IU), copying result to VT */
  1378. /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  1379. i__2 = *lwork - iwork + 1;
  1380. _starpu_dgebrd_(n, n, &work[iu], &ldwrku, &s[1], &work[ie], &
  1381. work[itauq], &work[itaup], &work[iwork], &
  1382. i__2, &ierr);
  1383. _starpu_dlacpy_("U", n, n, &work[iu], &ldwrku, &vt[vt_offset],
  1384. ldvt);
  1385. /* Generate left bidiagonalizing vectors in WORK(IU) */
  1386. /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  1387. i__2 = *lwork - iwork + 1;
  1388. _starpu_dorgbr_("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
  1389. , &work[iwork], &i__2, &ierr);
  1390. /* Generate right bidiagonalizing vectors in VT */
  1391. /* (Workspace: need N*N+4*N-1, */
  1392. /* prefer N*N+3*N+(N-1)*NB) */
  1393. i__2 = *lwork - iwork + 1;
  1394. _starpu_dorgbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[
  1395. itaup], &work[iwork], &i__2, &ierr)
  1396. ;
  1397. iwork = ie + *n;
  1398. /* Perform bidiagonal QR iteration, computing left */
  1399. /* singular vectors of R in WORK(IU) and computing */
  1400. /* right singular vectors of R in VT */
  1401. /* (Workspace: need N*N+BDSPAC) */
  1402. _starpu_dbdsqr_("U", n, n, n, &c__0, &s[1], &work[ie], &vt[
  1403. vt_offset], ldvt, &work[iu], &ldwrku, dum, &
  1404. c__1, &work[iwork], info);
  1405. /* Multiply Q in A by left singular vectors of R in */
  1406. /* WORK(IU), storing result in U */
  1407. /* (Workspace: need N*N) */
  1408. _starpu_dgemm_("N", "N", m, n, n, &c_b443, &a[a_offset], lda,
  1409. &work[iu], &ldwrku, &c_b421, &u[u_offset],
  1410. ldu);
  1411. } else {
  1412. /* Insufficient workspace for a fast algorithm */
  1413. itau = 1;
  1414. iwork = itau + *n;
  1415. /* Compute A=Q*R, copying result to U */
  1416. /* (Workspace: need 2*N, prefer N+N*NB) */
  1417. i__2 = *lwork - iwork + 1;
  1418. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1419. iwork], &i__2, &ierr);
  1420. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1421. ldu);
  1422. /* Generate Q in U */
  1423. /* (Workspace: need 2*N, prefer N+N*NB) */
  1424. i__2 = *lwork - iwork + 1;
  1425. _starpu_dorgqr_(m, n, n, &u[u_offset], ldu, &work[itau], &
  1426. work[iwork], &i__2, &ierr);
  1427. /* Copy R to VT, zeroing out below it */
  1428. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset],
  1429. ldvt);
  1430. if (*n > 1) {
  1431. i__2 = *n - 1;
  1432. i__3 = *n - 1;
  1433. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &vt[
  1434. vt_dim1 + 2], ldvt);
  1435. }
  1436. ie = itau;
  1437. itauq = ie + *n;
  1438. itaup = itauq + *n;
  1439. iwork = itaup + *n;
  1440. /* Bidiagonalize R in VT */
  1441. /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  1442. i__2 = *lwork - iwork + 1;
  1443. _starpu_dgebrd_(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie],
  1444. &work[itauq], &work[itaup], &work[iwork], &
  1445. i__2, &ierr);
  1446. /* Multiply Q in U by left bidiagonalizing vectors */
  1447. /* in VT */
  1448. /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  1449. i__2 = *lwork - iwork + 1;
  1450. _starpu_dormbr_("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt,
  1451. &work[itauq], &u[u_offset], ldu, &work[iwork],
  1452. &i__2, &ierr);
  1453. /* Generate right bidiagonalizing vectors in VT */
  1454. /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  1455. i__2 = *lwork - iwork + 1;
  1456. _starpu_dorgbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[
  1457. itaup], &work[iwork], &i__2, &ierr)
  1458. ;
  1459. iwork = ie + *n;
  1460. /* Perform bidiagonal QR iteration, computing left */
  1461. /* singular vectors of A in U and computing right */
  1462. /* singular vectors of A in VT */
  1463. /* (Workspace: need BDSPAC) */
  1464. _starpu_dbdsqr_("U", n, n, m, &c__0, &s[1], &work[ie], &vt[
  1465. vt_offset], ldvt, &u[u_offset], ldu, dum, &
  1466. c__1, &work[iwork], info);
  1467. }
  1468. }
  1469. } else if (wntua) {
  1470. if (wntvn) {
  1471. /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */
  1472. /* M left singular vectors to be computed in U and */
  1473. /* no right singular vectors to be computed */
  1474. /* Computing MAX */
  1475. i__2 = *n + *m, i__3 = *n << 2, i__2 = max(i__2,i__3);
  1476. if (*lwork >= *n * *n + max(i__2,bdspac)) {
  1477. /* Sufficient workspace for a fast algorithm */
  1478. ir = 1;
  1479. if (*lwork >= wrkbl + *lda * *n) {
  1480. /* WORK(IR) is LDA by N */
  1481. ldwrkr = *lda;
  1482. } else {
  1483. /* WORK(IR) is N by N */
  1484. ldwrkr = *n;
  1485. }
  1486. itau = ir + ldwrkr * *n;
  1487. iwork = itau + *n;
  1488. /* Compute A=Q*R, copying result to U */
  1489. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1490. i__2 = *lwork - iwork + 1;
  1491. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1492. iwork], &i__2, &ierr);
  1493. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1494. ldu);
  1495. /* Copy R to WORK(IR), zeroing out below it */
  1496. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &
  1497. ldwrkr);
  1498. i__2 = *n - 1;
  1499. i__3 = *n - 1;
  1500. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &work[ir
  1501. + 1], &ldwrkr);
  1502. /* Generate Q in U */
  1503. /* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) */
  1504. i__2 = *lwork - iwork + 1;
  1505. _starpu_dorgqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  1506. work[iwork], &i__2, &ierr);
  1507. ie = itau;
  1508. itauq = ie + *n;
  1509. itaup = itauq + *n;
  1510. iwork = itaup + *n;
  1511. /* Bidiagonalize R in WORK(IR) */
  1512. /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  1513. i__2 = *lwork - iwork + 1;
  1514. _starpu_dgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &
  1515. work[itauq], &work[itaup], &work[iwork], &
  1516. i__2, &ierr);
  1517. /* Generate left bidiagonalizing vectors in WORK(IR) */
  1518. /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  1519. i__2 = *lwork - iwork + 1;
  1520. _starpu_dorgbr_("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq]
  1521. , &work[iwork], &i__2, &ierr);
  1522. iwork = ie + *n;
  1523. /* Perform bidiagonal QR iteration, computing left */
  1524. /* singular vectors of R in WORK(IR) */
  1525. /* (Workspace: need N*N+BDSPAC) */
  1526. _starpu_dbdsqr_("U", n, &c__0, n, &c__0, &s[1], &work[ie],
  1527. dum, &c__1, &work[ir], &ldwrkr, dum, &c__1, &
  1528. work[iwork], info);
  1529. /* Multiply Q in U by left singular vectors of R in */
  1530. /* WORK(IR), storing result in A */
  1531. /* (Workspace: need N*N) */
  1532. _starpu_dgemm_("N", "N", m, n, n, &c_b443, &u[u_offset], ldu,
  1533. &work[ir], &ldwrkr, &c_b421, &a[a_offset],
  1534. lda);
  1535. /* Copy left singular vectors of A from A to U */
  1536. _starpu_dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset],
  1537. ldu);
  1538. } else {
  1539. /* Insufficient workspace for a fast algorithm */
  1540. itau = 1;
  1541. iwork = itau + *n;
  1542. /* Compute A=Q*R, copying result to U */
  1543. /* (Workspace: need 2*N, prefer N+N*NB) */
  1544. i__2 = *lwork - iwork + 1;
  1545. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1546. iwork], &i__2, &ierr);
  1547. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1548. ldu);
  1549. /* Generate Q in U */
  1550. /* (Workspace: need N+M, prefer N+M*NB) */
  1551. i__2 = *lwork - iwork + 1;
  1552. _starpu_dorgqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  1553. work[iwork], &i__2, &ierr);
  1554. ie = itau;
  1555. itauq = ie + *n;
  1556. itaup = itauq + *n;
  1557. iwork = itaup + *n;
  1558. /* Zero out below R in A */
  1559. i__2 = *n - 1;
  1560. i__3 = *n - 1;
  1561. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &a[
  1562. a_dim1 + 2], lda);
  1563. /* Bidiagonalize R in A */
  1564. /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  1565. i__2 = *lwork - iwork + 1;
  1566. _starpu_dgebrd_(n, n, &a[a_offset], lda, &s[1], &work[ie], &
  1567. work[itauq], &work[itaup], &work[iwork], &
  1568. i__2, &ierr);
  1569. /* Multiply Q in U by left bidiagonalizing vectors */
  1570. /* in A */
  1571. /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  1572. i__2 = *lwork - iwork + 1;
  1573. _starpu_dormbr_("Q", "R", "N", m, n, n, &a[a_offset], lda, &
  1574. work[itauq], &u[u_offset], ldu, &work[iwork],
  1575. &i__2, &ierr)
  1576. ;
  1577. iwork = ie + *n;
  1578. /* Perform bidiagonal QR iteration, computing left */
  1579. /* singular vectors of A in U */
  1580. /* (Workspace: need BDSPAC) */
  1581. _starpu_dbdsqr_("U", n, &c__0, m, &c__0, &s[1], &work[ie],
  1582. dum, &c__1, &u[u_offset], ldu, dum, &c__1, &
  1583. work[iwork], info);
  1584. }
  1585. } else if (wntvo) {
  1586. /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */
  1587. /* M left singular vectors to be computed in U and */
  1588. /* N right singular vectors to be overwritten on A */
  1589. /* Computing MAX */
  1590. i__2 = *n + *m, i__3 = *n << 2, i__2 = max(i__2,i__3);
  1591. if (*lwork >= (*n << 1) * *n + max(i__2,bdspac)) {
  1592. /* Sufficient workspace for a fast algorithm */
  1593. iu = 1;
  1594. if (*lwork >= wrkbl + (*lda << 1) * *n) {
  1595. /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */
  1596. ldwrku = *lda;
  1597. ir = iu + ldwrku * *n;
  1598. ldwrkr = *lda;
  1599. } else if (*lwork >= wrkbl + (*lda + *n) * *n) {
  1600. /* WORK(IU) is LDA by N and WORK(IR) is N by N */
  1601. ldwrku = *lda;
  1602. ir = iu + ldwrku * *n;
  1603. ldwrkr = *n;
  1604. } else {
  1605. /* WORK(IU) is N by N and WORK(IR) is N by N */
  1606. ldwrku = *n;
  1607. ir = iu + ldwrku * *n;
  1608. ldwrkr = *n;
  1609. }
  1610. itau = ir + ldwrkr * *n;
  1611. iwork = itau + *n;
  1612. /* Compute A=Q*R, copying result to U */
  1613. /* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */
  1614. i__2 = *lwork - iwork + 1;
  1615. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1616. iwork], &i__2, &ierr);
  1617. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1618. ldu);
  1619. /* Generate Q in U */
  1620. /* (Workspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB) */
  1621. i__2 = *lwork - iwork + 1;
  1622. _starpu_dorgqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  1623. work[iwork], &i__2, &ierr);
  1624. /* Copy R to WORK(IU), zeroing out below it */
  1625. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &
  1626. ldwrku);
  1627. i__2 = *n - 1;
  1628. i__3 = *n - 1;
  1629. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &work[iu
  1630. + 1], &ldwrku);
  1631. ie = itau;
  1632. itauq = ie + *n;
  1633. itaup = itauq + *n;
  1634. iwork = itaup + *n;
  1635. /* Bidiagonalize R in WORK(IU), copying result to */
  1636. /* WORK(IR) */
  1637. /* (Workspace: need 2*N*N+4*N, */
  1638. /* prefer 2*N*N+3*N+2*N*NB) */
  1639. i__2 = *lwork - iwork + 1;
  1640. _starpu_dgebrd_(n, n, &work[iu], &ldwrku, &s[1], &work[ie], &
  1641. work[itauq], &work[itaup], &work[iwork], &
  1642. i__2, &ierr);
  1643. _starpu_dlacpy_("U", n, n, &work[iu], &ldwrku, &work[ir], &
  1644. ldwrkr);
  1645. /* Generate left bidiagonalizing vectors in WORK(IU) */
  1646. /* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB) */
  1647. i__2 = *lwork - iwork + 1;
  1648. _starpu_dorgbr_("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
  1649. , &work[iwork], &i__2, &ierr);
  1650. /* Generate right bidiagonalizing vectors in WORK(IR) */
  1651. /* (Workspace: need 2*N*N+4*N-1, */
  1652. /* prefer 2*N*N+3*N+(N-1)*NB) */
  1653. i__2 = *lwork - iwork + 1;
  1654. _starpu_dorgbr_("P", n, n, n, &work[ir], &ldwrkr, &work[itaup]
  1655. , &work[iwork], &i__2, &ierr);
  1656. iwork = ie + *n;
  1657. /* Perform bidiagonal QR iteration, computing left */
  1658. /* singular vectors of R in WORK(IU) and computing */
  1659. /* right singular vectors of R in WORK(IR) */
  1660. /* (Workspace: need 2*N*N+BDSPAC) */
  1661. _starpu_dbdsqr_("U", n, n, n, &c__0, &s[1], &work[ie], &work[
  1662. ir], &ldwrkr, &work[iu], &ldwrku, dum, &c__1,
  1663. &work[iwork], info);
  1664. /* Multiply Q in U by left singular vectors of R in */
  1665. /* WORK(IU), storing result in A */
  1666. /* (Workspace: need N*N) */
  1667. _starpu_dgemm_("N", "N", m, n, n, &c_b443, &u[u_offset], ldu,
  1668. &work[iu], &ldwrku, &c_b421, &a[a_offset],
  1669. lda);
  1670. /* Copy left singular vectors of A from A to U */
  1671. _starpu_dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset],
  1672. ldu);
  1673. /* Copy right singular vectors of R from WORK(IR) to A */
  1674. _starpu_dlacpy_("F", n, n, &work[ir], &ldwrkr, &a[a_offset],
  1675. lda);
  1676. } else {
  1677. /* Insufficient workspace for a fast algorithm */
  1678. itau = 1;
  1679. iwork = itau + *n;
  1680. /* Compute A=Q*R, copying result to U */
  1681. /* (Workspace: need 2*N, prefer N+N*NB) */
  1682. i__2 = *lwork - iwork + 1;
  1683. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1684. iwork], &i__2, &ierr);
  1685. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1686. ldu);
  1687. /* Generate Q in U */
  1688. /* (Workspace: need N+M, prefer N+M*NB) */
  1689. i__2 = *lwork - iwork + 1;
  1690. _starpu_dorgqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  1691. work[iwork], &i__2, &ierr);
  1692. ie = itau;
  1693. itauq = ie + *n;
  1694. itaup = itauq + *n;
  1695. iwork = itaup + *n;
  1696. /* Zero out below R in A */
  1697. i__2 = *n - 1;
  1698. i__3 = *n - 1;
  1699. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &a[
  1700. a_dim1 + 2], lda);
  1701. /* Bidiagonalize R in A */
  1702. /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  1703. i__2 = *lwork - iwork + 1;
  1704. _starpu_dgebrd_(n, n, &a[a_offset], lda, &s[1], &work[ie], &
  1705. work[itauq], &work[itaup], &work[iwork], &
  1706. i__2, &ierr);
  1707. /* Multiply Q in U by left bidiagonalizing vectors */
  1708. /* in A */
  1709. /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  1710. i__2 = *lwork - iwork + 1;
  1711. _starpu_dormbr_("Q", "R", "N", m, n, n, &a[a_offset], lda, &
  1712. work[itauq], &u[u_offset], ldu, &work[iwork],
  1713. &i__2, &ierr)
  1714. ;
  1715. /* Generate right bidiagonalizing vectors in A */
  1716. /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  1717. i__2 = *lwork - iwork + 1;
  1718. _starpu_dorgbr_("P", n, n, n, &a[a_offset], lda, &work[itaup],
  1719. &work[iwork], &i__2, &ierr);
  1720. iwork = ie + *n;
  1721. /* Perform bidiagonal QR iteration, computing left */
  1722. /* singular vectors of A in U and computing right */
  1723. /* singular vectors of A in A */
  1724. /* (Workspace: need BDSPAC) */
  1725. _starpu_dbdsqr_("U", n, n, m, &c__0, &s[1], &work[ie], &a[
  1726. a_offset], lda, &u[u_offset], ldu, dum, &c__1,
  1727. &work[iwork], info);
  1728. }
  1729. } else if (wntvas) {
  1730. /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' */
  1731. /* or 'A') */
  1732. /* M left singular vectors to be computed in U and */
  1733. /* N right singular vectors to be computed in VT */
  1734. /* Computing MAX */
  1735. i__2 = *n + *m, i__3 = *n << 2, i__2 = max(i__2,i__3);
  1736. if (*lwork >= *n * *n + max(i__2,bdspac)) {
  1737. /* Sufficient workspace for a fast algorithm */
  1738. iu = 1;
  1739. if (*lwork >= wrkbl + *lda * *n) {
  1740. /* WORK(IU) is LDA by N */
  1741. ldwrku = *lda;
  1742. } else {
  1743. /* WORK(IU) is N by N */
  1744. ldwrku = *n;
  1745. }
  1746. itau = iu + ldwrku * *n;
  1747. iwork = itau + *n;
  1748. /* Compute A=Q*R, copying result to U */
  1749. /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1750. i__2 = *lwork - iwork + 1;
  1751. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1752. iwork], &i__2, &ierr);
  1753. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1754. ldu);
  1755. /* Generate Q in U */
  1756. /* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) */
  1757. i__2 = *lwork - iwork + 1;
  1758. _starpu_dorgqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  1759. work[iwork], &i__2, &ierr);
  1760. /* Copy R to WORK(IU), zeroing out below it */
  1761. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &
  1762. ldwrku);
  1763. i__2 = *n - 1;
  1764. i__3 = *n - 1;
  1765. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &work[iu
  1766. + 1], &ldwrku);
  1767. ie = itau;
  1768. itauq = ie + *n;
  1769. itaup = itauq + *n;
  1770. iwork = itaup + *n;
  1771. /* Bidiagonalize R in WORK(IU), copying result to VT */
  1772. /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  1773. i__2 = *lwork - iwork + 1;
  1774. _starpu_dgebrd_(n, n, &work[iu], &ldwrku, &s[1], &work[ie], &
  1775. work[itauq], &work[itaup], &work[iwork], &
  1776. i__2, &ierr);
  1777. _starpu_dlacpy_("U", n, n, &work[iu], &ldwrku, &vt[vt_offset],
  1778. ldvt);
  1779. /* Generate left bidiagonalizing vectors in WORK(IU) */
  1780. /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  1781. i__2 = *lwork - iwork + 1;
  1782. _starpu_dorgbr_("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
  1783. , &work[iwork], &i__2, &ierr);
  1784. /* Generate right bidiagonalizing vectors in VT */
  1785. /* (Workspace: need N*N+4*N-1, */
  1786. /* prefer N*N+3*N+(N-1)*NB) */
  1787. i__2 = *lwork - iwork + 1;
  1788. _starpu_dorgbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[
  1789. itaup], &work[iwork], &i__2, &ierr)
  1790. ;
  1791. iwork = ie + *n;
  1792. /* Perform bidiagonal QR iteration, computing left */
  1793. /* singular vectors of R in WORK(IU) and computing */
  1794. /* right singular vectors of R in VT */
  1795. /* (Workspace: need N*N+BDSPAC) */
  1796. _starpu_dbdsqr_("U", n, n, n, &c__0, &s[1], &work[ie], &vt[
  1797. vt_offset], ldvt, &work[iu], &ldwrku, dum, &
  1798. c__1, &work[iwork], info);
  1799. /* Multiply Q in U by left singular vectors of R in */
  1800. /* WORK(IU), storing result in A */
  1801. /* (Workspace: need N*N) */
  1802. _starpu_dgemm_("N", "N", m, n, n, &c_b443, &u[u_offset], ldu,
  1803. &work[iu], &ldwrku, &c_b421, &a[a_offset],
  1804. lda);
  1805. /* Copy left singular vectors of A from A to U */
  1806. _starpu_dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset],
  1807. ldu);
  1808. } else {
  1809. /* Insufficient workspace for a fast algorithm */
  1810. itau = 1;
  1811. iwork = itau + *n;
  1812. /* Compute A=Q*R, copying result to U */
  1813. /* (Workspace: need 2*N, prefer N+N*NB) */
  1814. i__2 = *lwork - iwork + 1;
  1815. _starpu_dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1816. iwork], &i__2, &ierr);
  1817. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1818. ldu);
  1819. /* Generate Q in U */
  1820. /* (Workspace: need N+M, prefer N+M*NB) */
  1821. i__2 = *lwork - iwork + 1;
  1822. _starpu_dorgqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  1823. work[iwork], &i__2, &ierr);
  1824. /* Copy R from A to VT, zeroing out below it */
  1825. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset],
  1826. ldvt);
  1827. if (*n > 1) {
  1828. i__2 = *n - 1;
  1829. i__3 = *n - 1;
  1830. _starpu_dlaset_("L", &i__2, &i__3, &c_b421, &c_b421, &vt[
  1831. vt_dim1 + 2], ldvt);
  1832. }
  1833. ie = itau;
  1834. itauq = ie + *n;
  1835. itaup = itauq + *n;
  1836. iwork = itaup + *n;
  1837. /* Bidiagonalize R in VT */
  1838. /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  1839. i__2 = *lwork - iwork + 1;
  1840. _starpu_dgebrd_(n, n, &vt[vt_offset], ldvt, &s[1], &work[ie],
  1841. &work[itauq], &work[itaup], &work[iwork], &
  1842. i__2, &ierr);
  1843. /* Multiply Q in U by left bidiagonalizing vectors */
  1844. /* in VT */
  1845. /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  1846. i__2 = *lwork - iwork + 1;
  1847. _starpu_dormbr_("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt,
  1848. &work[itauq], &u[u_offset], ldu, &work[iwork],
  1849. &i__2, &ierr);
  1850. /* Generate right bidiagonalizing vectors in VT */
  1851. /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  1852. i__2 = *lwork - iwork + 1;
  1853. _starpu_dorgbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[
  1854. itaup], &work[iwork], &i__2, &ierr)
  1855. ;
  1856. iwork = ie + *n;
  1857. /* Perform bidiagonal QR iteration, computing left */
  1858. /* singular vectors of A in U and computing right */
  1859. /* singular vectors of A in VT */
  1860. /* (Workspace: need BDSPAC) */
  1861. _starpu_dbdsqr_("U", n, n, m, &c__0, &s[1], &work[ie], &vt[
  1862. vt_offset], ldvt, &u[u_offset], ldu, dum, &
  1863. c__1, &work[iwork], info);
  1864. }
  1865. }
  1866. }
  1867. } else {
  1868. /* M .LT. MNTHR */
  1869. /* Path 10 (M at least N, but not much larger) */
  1870. /* Reduce to bidiagonal form without QR decomposition */
  1871. ie = 1;
  1872. itauq = ie + *n;
  1873. itaup = itauq + *n;
  1874. iwork = itaup + *n;
  1875. /* Bidiagonalize A */
  1876. /* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) */
  1877. i__2 = *lwork - iwork + 1;
  1878. _starpu_dgebrd_(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
  1879. work[itaup], &work[iwork], &i__2, &ierr);
  1880. if (wntuas) {
  1881. /* If left singular vectors desired in U, copy result to U */
  1882. /* and generate left bidiagonalizing vectors in U */
  1883. /* (Workspace: need 3*N+NCU, prefer 3*N+NCU*NB) */
  1884. _starpu_dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
  1885. if (wntus) {
  1886. ncu = *n;
  1887. }
  1888. if (wntua) {
  1889. ncu = *m;
  1890. }
  1891. i__2 = *lwork - iwork + 1;
  1892. _starpu_dorgbr_("Q", m, &ncu, n, &u[u_offset], ldu, &work[itauq], &
  1893. work[iwork], &i__2, &ierr);
  1894. }
  1895. if (wntvas) {
  1896. /* If right singular vectors desired in VT, copy result to */
  1897. /* VT and generate right bidiagonalizing vectors in VT */
  1898. /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  1899. _starpu_dlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
  1900. i__2 = *lwork - iwork + 1;
  1901. _starpu_dorgbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &
  1902. work[iwork], &i__2, &ierr);
  1903. }
  1904. if (wntuo) {
  1905. /* If left singular vectors desired in A, generate left */
  1906. /* bidiagonalizing vectors in A */
  1907. /* (Workspace: need 4*N, prefer 3*N+N*NB) */
  1908. i__2 = *lwork - iwork + 1;
  1909. _starpu_dorgbr_("Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[
  1910. iwork], &i__2, &ierr);
  1911. }
  1912. if (wntvo) {
  1913. /* If right singular vectors desired in A, generate right */
  1914. /* bidiagonalizing vectors in A */
  1915. /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  1916. i__2 = *lwork - iwork + 1;
  1917. _starpu_dorgbr_("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[
  1918. iwork], &i__2, &ierr);
  1919. }
  1920. iwork = ie + *n;
  1921. if (wntuas || wntuo) {
  1922. nru = *m;
  1923. }
  1924. if (wntun) {
  1925. nru = 0;
  1926. }
  1927. if (wntvas || wntvo) {
  1928. ncvt = *n;
  1929. }
  1930. if (wntvn) {
  1931. ncvt = 0;
  1932. }
  1933. if (! wntuo && ! wntvo) {
  1934. /* Perform bidiagonal QR iteration, if desired, computing */
  1935. /* left singular vectors in U and computing right singular */
  1936. /* vectors in VT */
  1937. /* (Workspace: need BDSPAC) */
  1938. _starpu_dbdsqr_("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[
  1939. vt_offset], ldvt, &u[u_offset], ldu, dum, &c__1, &
  1940. work[iwork], info);
  1941. } else if (! wntuo && wntvo) {
  1942. /* Perform bidiagonal QR iteration, if desired, computing */
  1943. /* left singular vectors in U and computing right singular */
  1944. /* vectors in A */
  1945. /* (Workspace: need BDSPAC) */
  1946. _starpu_dbdsqr_("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &a[
  1947. a_offset], lda, &u[u_offset], ldu, dum, &c__1, &work[
  1948. iwork], info);
  1949. } else {
  1950. /* Perform bidiagonal QR iteration, if desired, computing */
  1951. /* left singular vectors in A and computing right singular */
  1952. /* vectors in VT */
  1953. /* (Workspace: need BDSPAC) */
  1954. _starpu_dbdsqr_("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[
  1955. vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, &
  1956. work[iwork], info);
  1957. }
  1958. }
  1959. } else {
  1960. /* A has more columns than rows. If A has sufficiently more */
  1961. /* columns than rows, first reduce using the LQ decomposition (if */
  1962. /* sufficient workspace available) */
  1963. if (*n >= mnthr) {
  1964. if (wntvn) {
  1965. /* Path 1t(N much larger than M, JOBVT='N') */
  1966. /* No right singular vectors to be computed */
  1967. itau = 1;
  1968. iwork = itau + *m;
  1969. /* Compute A=L*Q */
  1970. /* (Workspace: need 2*M, prefer M+M*NB) */
  1971. i__2 = *lwork - iwork + 1;
  1972. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &
  1973. i__2, &ierr);
  1974. /* Zero out above L */
  1975. i__2 = *m - 1;
  1976. i__3 = *m - 1;
  1977. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &a[(a_dim1 << 1)
  1978. + 1], lda);
  1979. ie = 1;
  1980. itauq = ie + *m;
  1981. itaup = itauq + *m;
  1982. iwork = itaup + *m;
  1983. /* Bidiagonalize L in A */
  1984. /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
  1985. i__2 = *lwork - iwork + 1;
  1986. _starpu_dgebrd_(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[
  1987. itauq], &work[itaup], &work[iwork], &i__2, &ierr);
  1988. if (wntuo || wntuas) {
  1989. /* If left singular vectors desired, generate Q */
  1990. /* (Workspace: need 4*M, prefer 3*M+M*NB) */
  1991. i__2 = *lwork - iwork + 1;
  1992. _starpu_dorgbr_("Q", m, m, m, &a[a_offset], lda, &work[itauq], &
  1993. work[iwork], &i__2, &ierr);
  1994. }
  1995. iwork = ie + *m;
  1996. nru = 0;
  1997. if (wntuo || wntuas) {
  1998. nru = *m;
  1999. }
  2000. /* Perform bidiagonal QR iteration, computing left singular */
  2001. /* vectors of A in A if desired */
  2002. /* (Workspace: need BDSPAC) */
  2003. _starpu_dbdsqr_("U", m, &c__0, &nru, &c__0, &s[1], &work[ie], dum, &
  2004. c__1, &a[a_offset], lda, dum, &c__1, &work[iwork],
  2005. info);
  2006. /* If left singular vectors desired in U, copy them there */
  2007. if (wntuas) {
  2008. _starpu_dlacpy_("F", m, m, &a[a_offset], lda, &u[u_offset], ldu);
  2009. }
  2010. } else if (wntvo && wntun) {
  2011. /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */
  2012. /* M right singular vectors to be overwritten on A and */
  2013. /* no left singular vectors to be computed */
  2014. /* Computing MAX */
  2015. i__2 = *m << 2;
  2016. if (*lwork >= *m * *m + max(i__2,bdspac)) {
  2017. /* Sufficient workspace for a fast algorithm */
  2018. ir = 1;
  2019. /* Computing MAX */
  2020. i__2 = wrkbl, i__3 = *lda * *n + *m;
  2021. if (*lwork >= max(i__2,i__3) + *lda * *m) {
  2022. /* WORK(IU) is LDA by N and WORK(IR) is LDA by M */
  2023. ldwrku = *lda;
  2024. chunk = *n;
  2025. ldwrkr = *lda;
  2026. } else /* if(complicated condition) */ {
  2027. /* Computing MAX */
  2028. i__2 = wrkbl, i__3 = *lda * *n + *m;
  2029. if (*lwork >= max(i__2,i__3) + *m * *m) {
  2030. /* WORK(IU) is LDA by N and WORK(IR) is M by M */
  2031. ldwrku = *lda;
  2032. chunk = *n;
  2033. ldwrkr = *m;
  2034. } else {
  2035. /* WORK(IU) is M by CHUNK and WORK(IR) is M by M */
  2036. ldwrku = *m;
  2037. chunk = (*lwork - *m * *m - *m) / *m;
  2038. ldwrkr = *m;
  2039. }
  2040. }
  2041. itau = ir + ldwrkr * *m;
  2042. iwork = itau + *m;
  2043. /* Compute A=L*Q */
  2044. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2045. i__2 = *lwork - iwork + 1;
  2046. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  2047. , &i__2, &ierr);
  2048. /* Copy L to WORK(IR) and zero out above it */
  2049. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr);
  2050. i__2 = *m - 1;
  2051. i__3 = *m - 1;
  2052. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &work[ir +
  2053. ldwrkr], &ldwrkr);
  2054. /* Generate Q in A */
  2055. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2056. i__2 = *lwork - iwork + 1;
  2057. _starpu_dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[
  2058. iwork], &i__2, &ierr);
  2059. ie = itau;
  2060. itauq = ie + *m;
  2061. itaup = itauq + *m;
  2062. iwork = itaup + *m;
  2063. /* Bidiagonalize L in WORK(IR) */
  2064. /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
  2065. i__2 = *lwork - iwork + 1;
  2066. _starpu_dgebrd_(m, m, &work[ir], &ldwrkr, &s[1], &work[ie], &work[
  2067. itauq], &work[itaup], &work[iwork], &i__2, &ierr);
  2068. /* Generate right vectors bidiagonalizing L */
  2069. /* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) */
  2070. i__2 = *lwork - iwork + 1;
  2071. _starpu_dorgbr_("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &
  2072. work[iwork], &i__2, &ierr);
  2073. iwork = ie + *m;
  2074. /* Perform bidiagonal QR iteration, computing right */
  2075. /* singular vectors of L in WORK(IR) */
  2076. /* (Workspace: need M*M+BDSPAC) */
  2077. _starpu_dbdsqr_("U", m, m, &c__0, &c__0, &s[1], &work[ie], &work[
  2078. ir], &ldwrkr, dum, &c__1, dum, &c__1, &work[iwork]
  2079. , info);
  2080. iu = ie + *m;
  2081. /* Multiply right singular vectors of L in WORK(IR) by Q */
  2082. /* in A, storing result in WORK(IU) and copying to A */
  2083. /* (Workspace: need M*M+2*M, prefer M*M+M*N+M) */
  2084. i__2 = *n;
  2085. i__3 = chunk;
  2086. for (i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
  2087. i__3) {
  2088. /* Computing MIN */
  2089. i__4 = *n - i__ + 1;
  2090. blk = min(i__4,chunk);
  2091. _starpu_dgemm_("N", "N", m, &blk, m, &c_b443, &work[ir], &
  2092. ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b421, &
  2093. work[iu], &ldwrku);
  2094. _starpu_dlacpy_("F", m, &blk, &work[iu], &ldwrku, &a[i__ *
  2095. a_dim1 + 1], lda);
  2096. /* L30: */
  2097. }
  2098. } else {
  2099. /* Insufficient workspace for a fast algorithm */
  2100. ie = 1;
  2101. itauq = ie + *m;
  2102. itaup = itauq + *m;
  2103. iwork = itaup + *m;
  2104. /* Bidiagonalize A */
  2105. /* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) */
  2106. i__3 = *lwork - iwork + 1;
  2107. _starpu_dgebrd_(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[
  2108. itauq], &work[itaup], &work[iwork], &i__3, &ierr);
  2109. /* Generate right vectors bidiagonalizing A */
  2110. /* (Workspace: need 4*M, prefer 3*M+M*NB) */
  2111. i__3 = *lwork - iwork + 1;
  2112. _starpu_dorgbr_("P", m, n, m, &a[a_offset], lda, &work[itaup], &
  2113. work[iwork], &i__3, &ierr);
  2114. iwork = ie + *m;
  2115. /* Perform bidiagonal QR iteration, computing right */
  2116. /* singular vectors of A in A */
  2117. /* (Workspace: need BDSPAC) */
  2118. _starpu_dbdsqr_("L", m, n, &c__0, &c__0, &s[1], &work[ie], &a[
  2119. a_offset], lda, dum, &c__1, dum, &c__1, &work[
  2120. iwork], info);
  2121. }
  2122. } else if (wntvo && wntuas) {
  2123. /* Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O') */
  2124. /* M right singular vectors to be overwritten on A and */
  2125. /* M left singular vectors to be computed in U */
  2126. /* Computing MAX */
  2127. i__3 = *m << 2;
  2128. if (*lwork >= *m * *m + max(i__3,bdspac)) {
  2129. /* Sufficient workspace for a fast algorithm */
  2130. ir = 1;
  2131. /* Computing MAX */
  2132. i__3 = wrkbl, i__2 = *lda * *n + *m;
  2133. if (*lwork >= max(i__3,i__2) + *lda * *m) {
  2134. /* WORK(IU) is LDA by N and WORK(IR) is LDA by M */
  2135. ldwrku = *lda;
  2136. chunk = *n;
  2137. ldwrkr = *lda;
  2138. } else /* if(complicated condition) */ {
  2139. /* Computing MAX */
  2140. i__3 = wrkbl, i__2 = *lda * *n + *m;
  2141. if (*lwork >= max(i__3,i__2) + *m * *m) {
  2142. /* WORK(IU) is LDA by N and WORK(IR) is M by M */
  2143. ldwrku = *lda;
  2144. chunk = *n;
  2145. ldwrkr = *m;
  2146. } else {
  2147. /* WORK(IU) is M by CHUNK and WORK(IR) is M by M */
  2148. ldwrku = *m;
  2149. chunk = (*lwork - *m * *m - *m) / *m;
  2150. ldwrkr = *m;
  2151. }
  2152. }
  2153. itau = ir + ldwrkr * *m;
  2154. iwork = itau + *m;
  2155. /* Compute A=L*Q */
  2156. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2157. i__3 = *lwork - iwork + 1;
  2158. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  2159. , &i__3, &ierr);
  2160. /* Copy L to U, zeroing about above it */
  2161. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
  2162. i__3 = *m - 1;
  2163. i__2 = *m - 1;
  2164. _starpu_dlaset_("U", &i__3, &i__2, &c_b421, &c_b421, &u[(u_dim1 <<
  2165. 1) + 1], ldu);
  2166. /* Generate Q in A */
  2167. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2168. i__3 = *lwork - iwork + 1;
  2169. _starpu_dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[
  2170. iwork], &i__3, &ierr);
  2171. ie = itau;
  2172. itauq = ie + *m;
  2173. itaup = itauq + *m;
  2174. iwork = itaup + *m;
  2175. /* Bidiagonalize L in U, copying result to WORK(IR) */
  2176. /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
  2177. i__3 = *lwork - iwork + 1;
  2178. _starpu_dgebrd_(m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[
  2179. itauq], &work[itaup], &work[iwork], &i__3, &ierr);
  2180. _starpu_dlacpy_("U", m, m, &u[u_offset], ldu, &work[ir], &ldwrkr);
  2181. /* Generate right vectors bidiagonalizing L in WORK(IR) */
  2182. /* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) */
  2183. i__3 = *lwork - iwork + 1;
  2184. _starpu_dorgbr_("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &
  2185. work[iwork], &i__3, &ierr);
  2186. /* Generate left vectors bidiagonalizing L in U */
  2187. /* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) */
  2188. i__3 = *lwork - iwork + 1;
  2189. _starpu_dorgbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &
  2190. work[iwork], &i__3, &ierr);
  2191. iwork = ie + *m;
  2192. /* Perform bidiagonal QR iteration, computing left */
  2193. /* singular vectors of L in U, and computing right */
  2194. /* singular vectors of L in WORK(IR) */
  2195. /* (Workspace: need M*M+BDSPAC) */
  2196. _starpu_dbdsqr_("U", m, m, m, &c__0, &s[1], &work[ie], &work[ir],
  2197. &ldwrkr, &u[u_offset], ldu, dum, &c__1, &work[
  2198. iwork], info);
  2199. iu = ie + *m;
  2200. /* Multiply right singular vectors of L in WORK(IR) by Q */
  2201. /* in A, storing result in WORK(IU) and copying to A */
  2202. /* (Workspace: need M*M+2*M, prefer M*M+M*N+M)) */
  2203. i__3 = *n;
  2204. i__2 = chunk;
  2205. for (i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ +=
  2206. i__2) {
  2207. /* Computing MIN */
  2208. i__4 = *n - i__ + 1;
  2209. blk = min(i__4,chunk);
  2210. _starpu_dgemm_("N", "N", m, &blk, m, &c_b443, &work[ir], &
  2211. ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b421, &
  2212. work[iu], &ldwrku);
  2213. _starpu_dlacpy_("F", m, &blk, &work[iu], &ldwrku, &a[i__ *
  2214. a_dim1 + 1], lda);
  2215. /* L40: */
  2216. }
  2217. } else {
  2218. /* Insufficient workspace for a fast algorithm */
  2219. itau = 1;
  2220. iwork = itau + *m;
  2221. /* Compute A=L*Q */
  2222. /* (Workspace: need 2*M, prefer M+M*NB) */
  2223. i__2 = *lwork - iwork + 1;
  2224. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  2225. , &i__2, &ierr);
  2226. /* Copy L to U, zeroing out above it */
  2227. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
  2228. i__2 = *m - 1;
  2229. i__3 = *m - 1;
  2230. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &u[(u_dim1 <<
  2231. 1) + 1], ldu);
  2232. /* Generate Q in A */
  2233. /* (Workspace: need 2*M, prefer M+M*NB) */
  2234. i__2 = *lwork - iwork + 1;
  2235. _starpu_dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[
  2236. iwork], &i__2, &ierr);
  2237. ie = itau;
  2238. itauq = ie + *m;
  2239. itaup = itauq + *m;
  2240. iwork = itaup + *m;
  2241. /* Bidiagonalize L in U */
  2242. /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
  2243. i__2 = *lwork - iwork + 1;
  2244. _starpu_dgebrd_(m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[
  2245. itauq], &work[itaup], &work[iwork], &i__2, &ierr);
  2246. /* Multiply right vectors bidiagonalizing L by Q in A */
  2247. /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
  2248. i__2 = *lwork - iwork + 1;
  2249. _starpu_dormbr_("P", "L", "T", m, n, m, &u[u_offset], ldu, &work[
  2250. itaup], &a[a_offset], lda, &work[iwork], &i__2, &
  2251. ierr);
  2252. /* Generate left vectors bidiagonalizing L in U */
  2253. /* (Workspace: need 4*M, prefer 3*M+M*NB) */
  2254. i__2 = *lwork - iwork + 1;
  2255. _starpu_dorgbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &
  2256. work[iwork], &i__2, &ierr);
  2257. iwork = ie + *m;
  2258. /* Perform bidiagonal QR iteration, computing left */
  2259. /* singular vectors of A in U and computing right */
  2260. /* singular vectors of A in A */
  2261. /* (Workspace: need BDSPAC) */
  2262. _starpu_dbdsqr_("U", m, n, m, &c__0, &s[1], &work[ie], &a[
  2263. a_offset], lda, &u[u_offset], ldu, dum, &c__1, &
  2264. work[iwork], info);
  2265. }
  2266. } else if (wntvs) {
  2267. if (wntun) {
  2268. /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */
  2269. /* M right singular vectors to be computed in VT and */
  2270. /* no left singular vectors to be computed */
  2271. /* Computing MAX */
  2272. i__2 = *m << 2;
  2273. if (*lwork >= *m * *m + max(i__2,bdspac)) {
  2274. /* Sufficient workspace for a fast algorithm */
  2275. ir = 1;
  2276. if (*lwork >= wrkbl + *lda * *m) {
  2277. /* WORK(IR) is LDA by M */
  2278. ldwrkr = *lda;
  2279. } else {
  2280. /* WORK(IR) is M by M */
  2281. ldwrkr = *m;
  2282. }
  2283. itau = ir + ldwrkr * *m;
  2284. iwork = itau + *m;
  2285. /* Compute A=L*Q */
  2286. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2287. i__2 = *lwork - iwork + 1;
  2288. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2289. iwork], &i__2, &ierr);
  2290. /* Copy L to WORK(IR), zeroing out above it */
  2291. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &
  2292. ldwrkr);
  2293. i__2 = *m - 1;
  2294. i__3 = *m - 1;
  2295. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &work[ir
  2296. + ldwrkr], &ldwrkr);
  2297. /* Generate Q in A */
  2298. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2299. i__2 = *lwork - iwork + 1;
  2300. _starpu_dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &
  2301. work[iwork], &i__2, &ierr);
  2302. ie = itau;
  2303. itauq = ie + *m;
  2304. itaup = itauq + *m;
  2305. iwork = itaup + *m;
  2306. /* Bidiagonalize L in WORK(IR) */
  2307. /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
  2308. i__2 = *lwork - iwork + 1;
  2309. _starpu_dgebrd_(m, m, &work[ir], &ldwrkr, &s[1], &work[ie], &
  2310. work[itauq], &work[itaup], &work[iwork], &
  2311. i__2, &ierr);
  2312. /* Generate right vectors bidiagonalizing L in */
  2313. /* WORK(IR) */
  2314. /* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB) */
  2315. i__2 = *lwork - iwork + 1;
  2316. _starpu_dorgbr_("P", m, m, m, &work[ir], &ldwrkr, &work[itaup]
  2317. , &work[iwork], &i__2, &ierr);
  2318. iwork = ie + *m;
  2319. /* Perform bidiagonal QR iteration, computing right */
  2320. /* singular vectors of L in WORK(IR) */
  2321. /* (Workspace: need M*M+BDSPAC) */
  2322. _starpu_dbdsqr_("U", m, m, &c__0, &c__0, &s[1], &work[ie], &
  2323. work[ir], &ldwrkr, dum, &c__1, dum, &c__1, &
  2324. work[iwork], info);
  2325. /* Multiply right singular vectors of L in WORK(IR) by */
  2326. /* Q in A, storing result in VT */
  2327. /* (Workspace: need M*M) */
  2328. _starpu_dgemm_("N", "N", m, n, m, &c_b443, &work[ir], &ldwrkr,
  2329. &a[a_offset], lda, &c_b421, &vt[vt_offset],
  2330. ldvt);
  2331. } else {
  2332. /* Insufficient workspace for a fast algorithm */
  2333. itau = 1;
  2334. iwork = itau + *m;
  2335. /* Compute A=L*Q */
  2336. /* (Workspace: need 2*M, prefer M+M*NB) */
  2337. i__2 = *lwork - iwork + 1;
  2338. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2339. iwork], &i__2, &ierr);
  2340. /* Copy result to VT */
  2341. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2342. ldvt);
  2343. /* Generate Q in VT */
  2344. /* (Workspace: need 2*M, prefer M+M*NB) */
  2345. i__2 = *lwork - iwork + 1;
  2346. _starpu_dorglq_(m, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2347. work[iwork], &i__2, &ierr);
  2348. ie = itau;
  2349. itauq = ie + *m;
  2350. itaup = itauq + *m;
  2351. iwork = itaup + *m;
  2352. /* Zero out above L in A */
  2353. i__2 = *m - 1;
  2354. i__3 = *m - 1;
  2355. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &a[(
  2356. a_dim1 << 1) + 1], lda);
  2357. /* Bidiagonalize L in A */
  2358. /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
  2359. i__2 = *lwork - iwork + 1;
  2360. _starpu_dgebrd_(m, m, &a[a_offset], lda, &s[1], &work[ie], &
  2361. work[itauq], &work[itaup], &work[iwork], &
  2362. i__2, &ierr);
  2363. /* Multiply right vectors bidiagonalizing L by Q in VT */
  2364. /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
  2365. i__2 = *lwork - iwork + 1;
  2366. _starpu_dormbr_("P", "L", "T", m, n, m, &a[a_offset], lda, &
  2367. work[itaup], &vt[vt_offset], ldvt, &work[
  2368. iwork], &i__2, &ierr);
  2369. iwork = ie + *m;
  2370. /* Perform bidiagonal QR iteration, computing right */
  2371. /* singular vectors of A in VT */
  2372. /* (Workspace: need BDSPAC) */
  2373. _starpu_dbdsqr_("U", m, n, &c__0, &c__0, &s[1], &work[ie], &
  2374. vt[vt_offset], ldvt, dum, &c__1, dum, &c__1, &
  2375. work[iwork], info);
  2376. }
  2377. } else if (wntuo) {
  2378. /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */
  2379. /* M right singular vectors to be computed in VT and */
  2380. /* M left singular vectors to be overwritten on A */
  2381. /* Computing MAX */
  2382. i__2 = *m << 2;
  2383. if (*lwork >= (*m << 1) * *m + max(i__2,bdspac)) {
  2384. /* Sufficient workspace for a fast algorithm */
  2385. iu = 1;
  2386. if (*lwork >= wrkbl + (*lda << 1) * *m) {
  2387. /* WORK(IU) is LDA by M and WORK(IR) is LDA by M */
  2388. ldwrku = *lda;
  2389. ir = iu + ldwrku * *m;
  2390. ldwrkr = *lda;
  2391. } else if (*lwork >= wrkbl + (*lda + *m) * *m) {
  2392. /* WORK(IU) is LDA by M and WORK(IR) is M by M */
  2393. ldwrku = *lda;
  2394. ir = iu + ldwrku * *m;
  2395. ldwrkr = *m;
  2396. } else {
  2397. /* WORK(IU) is M by M and WORK(IR) is M by M */
  2398. ldwrku = *m;
  2399. ir = iu + ldwrku * *m;
  2400. ldwrkr = *m;
  2401. }
  2402. itau = ir + ldwrkr * *m;
  2403. iwork = itau + *m;
  2404. /* Compute A=L*Q */
  2405. /* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */
  2406. i__2 = *lwork - iwork + 1;
  2407. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2408. iwork], &i__2, &ierr);
  2409. /* Copy L to WORK(IU), zeroing out below it */
  2410. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &
  2411. ldwrku);
  2412. i__2 = *m - 1;
  2413. i__3 = *m - 1;
  2414. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &work[iu
  2415. + ldwrku], &ldwrku);
  2416. /* Generate Q in A */
  2417. /* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */
  2418. i__2 = *lwork - iwork + 1;
  2419. _starpu_dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &
  2420. work[iwork], &i__2, &ierr);
  2421. ie = itau;
  2422. itauq = ie + *m;
  2423. itaup = itauq + *m;
  2424. iwork = itaup + *m;
  2425. /* Bidiagonalize L in WORK(IU), copying result to */
  2426. /* WORK(IR) */
  2427. /* (Workspace: need 2*M*M+4*M, */
  2428. /* prefer 2*M*M+3*M+2*M*NB) */
  2429. i__2 = *lwork - iwork + 1;
  2430. _starpu_dgebrd_(m, m, &work[iu], &ldwrku, &s[1], &work[ie], &
  2431. work[itauq], &work[itaup], &work[iwork], &
  2432. i__2, &ierr);
  2433. _starpu_dlacpy_("L", m, m, &work[iu], &ldwrku, &work[ir], &
  2434. ldwrkr);
  2435. /* Generate right bidiagonalizing vectors in WORK(IU) */
  2436. /* (Workspace: need 2*M*M+4*M-1, */
  2437. /* prefer 2*M*M+3*M+(M-1)*NB) */
  2438. i__2 = *lwork - iwork + 1;
  2439. _starpu_dorgbr_("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
  2440. , &work[iwork], &i__2, &ierr);
  2441. /* Generate left bidiagonalizing vectors in WORK(IR) */
  2442. /* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB) */
  2443. i__2 = *lwork - iwork + 1;
  2444. _starpu_dorgbr_("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq]
  2445. , &work[iwork], &i__2, &ierr);
  2446. iwork = ie + *m;
  2447. /* Perform bidiagonal QR iteration, computing left */
  2448. /* singular vectors of L in WORK(IR) and computing */
  2449. /* right singular vectors of L in WORK(IU) */
  2450. /* (Workspace: need 2*M*M+BDSPAC) */
  2451. _starpu_dbdsqr_("U", m, m, m, &c__0, &s[1], &work[ie], &work[
  2452. iu], &ldwrku, &work[ir], &ldwrkr, dum, &c__1,
  2453. &work[iwork], info);
  2454. /* Multiply right singular vectors of L in WORK(IU) by */
  2455. /* Q in A, storing result in VT */
  2456. /* (Workspace: need M*M) */
  2457. _starpu_dgemm_("N", "N", m, n, m, &c_b443, &work[iu], &ldwrku,
  2458. &a[a_offset], lda, &c_b421, &vt[vt_offset],
  2459. ldvt);
  2460. /* Copy left singular vectors of L to A */
  2461. /* (Workspace: need M*M) */
  2462. _starpu_dlacpy_("F", m, m, &work[ir], &ldwrkr, &a[a_offset],
  2463. lda);
  2464. } else {
  2465. /* Insufficient workspace for a fast algorithm */
  2466. itau = 1;
  2467. iwork = itau + *m;
  2468. /* Compute A=L*Q, copying result to VT */
  2469. /* (Workspace: need 2*M, prefer M+M*NB) */
  2470. i__2 = *lwork - iwork + 1;
  2471. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2472. iwork], &i__2, &ierr);
  2473. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2474. ldvt);
  2475. /* Generate Q in VT */
  2476. /* (Workspace: need 2*M, prefer M+M*NB) */
  2477. i__2 = *lwork - iwork + 1;
  2478. _starpu_dorglq_(m, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2479. work[iwork], &i__2, &ierr);
  2480. ie = itau;
  2481. itauq = ie + *m;
  2482. itaup = itauq + *m;
  2483. iwork = itaup + *m;
  2484. /* Zero out above L in A */
  2485. i__2 = *m - 1;
  2486. i__3 = *m - 1;
  2487. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &a[(
  2488. a_dim1 << 1) + 1], lda);
  2489. /* Bidiagonalize L in A */
  2490. /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
  2491. i__2 = *lwork - iwork + 1;
  2492. _starpu_dgebrd_(m, m, &a[a_offset], lda, &s[1], &work[ie], &
  2493. work[itauq], &work[itaup], &work[iwork], &
  2494. i__2, &ierr);
  2495. /* Multiply right vectors bidiagonalizing L by Q in VT */
  2496. /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
  2497. i__2 = *lwork - iwork + 1;
  2498. _starpu_dormbr_("P", "L", "T", m, n, m, &a[a_offset], lda, &
  2499. work[itaup], &vt[vt_offset], ldvt, &work[
  2500. iwork], &i__2, &ierr);
  2501. /* Generate left bidiagonalizing vectors of L in A */
  2502. /* (Workspace: need 4*M, prefer 3*M+M*NB) */
  2503. i__2 = *lwork - iwork + 1;
  2504. _starpu_dorgbr_("Q", m, m, m, &a[a_offset], lda, &work[itauq],
  2505. &work[iwork], &i__2, &ierr);
  2506. iwork = ie + *m;
  2507. /* Perform bidiagonal QR iteration, compute left */
  2508. /* singular vectors of A in A and compute right */
  2509. /* singular vectors of A in VT */
  2510. /* (Workspace: need BDSPAC) */
  2511. _starpu_dbdsqr_("U", m, n, m, &c__0, &s[1], &work[ie], &vt[
  2512. vt_offset], ldvt, &a[a_offset], lda, dum, &
  2513. c__1, &work[iwork], info);
  2514. }
  2515. } else if (wntuas) {
  2516. /* Path 6t(N much larger than M, JOBU='S' or 'A', */
  2517. /* JOBVT='S') */
  2518. /* M right singular vectors to be computed in VT and */
  2519. /* M left singular vectors to be computed in U */
  2520. /* Computing MAX */
  2521. i__2 = *m << 2;
  2522. if (*lwork >= *m * *m + max(i__2,bdspac)) {
  2523. /* Sufficient workspace for a fast algorithm */
  2524. iu = 1;
  2525. if (*lwork >= wrkbl + *lda * *m) {
  2526. /* WORK(IU) is LDA by N */
  2527. ldwrku = *lda;
  2528. } else {
  2529. /* WORK(IU) is LDA by M */
  2530. ldwrku = *m;
  2531. }
  2532. itau = iu + ldwrku * *m;
  2533. iwork = itau + *m;
  2534. /* Compute A=L*Q */
  2535. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2536. i__2 = *lwork - iwork + 1;
  2537. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2538. iwork], &i__2, &ierr);
  2539. /* Copy L to WORK(IU), zeroing out above it */
  2540. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &
  2541. ldwrku);
  2542. i__2 = *m - 1;
  2543. i__3 = *m - 1;
  2544. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &work[iu
  2545. + ldwrku], &ldwrku);
  2546. /* Generate Q in A */
  2547. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2548. i__2 = *lwork - iwork + 1;
  2549. _starpu_dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &
  2550. work[iwork], &i__2, &ierr);
  2551. ie = itau;
  2552. itauq = ie + *m;
  2553. itaup = itauq + *m;
  2554. iwork = itaup + *m;
  2555. /* Bidiagonalize L in WORK(IU), copying result to U */
  2556. /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
  2557. i__2 = *lwork - iwork + 1;
  2558. _starpu_dgebrd_(m, m, &work[iu], &ldwrku, &s[1], &work[ie], &
  2559. work[itauq], &work[itaup], &work[iwork], &
  2560. i__2, &ierr);
  2561. _starpu_dlacpy_("L", m, m, &work[iu], &ldwrku, &u[u_offset],
  2562. ldu);
  2563. /* Generate right bidiagonalizing vectors in WORK(IU) */
  2564. /* (Workspace: need M*M+4*M-1, */
  2565. /* prefer M*M+3*M+(M-1)*NB) */
  2566. i__2 = *lwork - iwork + 1;
  2567. _starpu_dorgbr_("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
  2568. , &work[iwork], &i__2, &ierr);
  2569. /* Generate left bidiagonalizing vectors in U */
  2570. /* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) */
  2571. i__2 = *lwork - iwork + 1;
  2572. _starpu_dorgbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
  2573. &work[iwork], &i__2, &ierr);
  2574. iwork = ie + *m;
  2575. /* Perform bidiagonal QR iteration, computing left */
  2576. /* singular vectors of L in U and computing right */
  2577. /* singular vectors of L in WORK(IU) */
  2578. /* (Workspace: need M*M+BDSPAC) */
  2579. _starpu_dbdsqr_("U", m, m, m, &c__0, &s[1], &work[ie], &work[
  2580. iu], &ldwrku, &u[u_offset], ldu, dum, &c__1, &
  2581. work[iwork], info);
  2582. /* Multiply right singular vectors of L in WORK(IU) by */
  2583. /* Q in A, storing result in VT */
  2584. /* (Workspace: need M*M) */
  2585. _starpu_dgemm_("N", "N", m, n, m, &c_b443, &work[iu], &ldwrku,
  2586. &a[a_offset], lda, &c_b421, &vt[vt_offset],
  2587. ldvt);
  2588. } else {
  2589. /* Insufficient workspace for a fast algorithm */
  2590. itau = 1;
  2591. iwork = itau + *m;
  2592. /* Compute A=L*Q, copying result to VT */
  2593. /* (Workspace: need 2*M, prefer M+M*NB) */
  2594. i__2 = *lwork - iwork + 1;
  2595. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2596. iwork], &i__2, &ierr);
  2597. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2598. ldvt);
  2599. /* Generate Q in VT */
  2600. /* (Workspace: need 2*M, prefer M+M*NB) */
  2601. i__2 = *lwork - iwork + 1;
  2602. _starpu_dorglq_(m, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2603. work[iwork], &i__2, &ierr);
  2604. /* Copy L to U, zeroing out above it */
  2605. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset],
  2606. ldu);
  2607. i__2 = *m - 1;
  2608. i__3 = *m - 1;
  2609. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &u[(
  2610. u_dim1 << 1) + 1], ldu);
  2611. ie = itau;
  2612. itauq = ie + *m;
  2613. itaup = itauq + *m;
  2614. iwork = itaup + *m;
  2615. /* Bidiagonalize L in U */
  2616. /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
  2617. i__2 = *lwork - iwork + 1;
  2618. _starpu_dgebrd_(m, m, &u[u_offset], ldu, &s[1], &work[ie], &
  2619. work[itauq], &work[itaup], &work[iwork], &
  2620. i__2, &ierr);
  2621. /* Multiply right bidiagonalizing vectors in U by Q */
  2622. /* in VT */
  2623. /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
  2624. i__2 = *lwork - iwork + 1;
  2625. _starpu_dormbr_("P", "L", "T", m, n, m, &u[u_offset], ldu, &
  2626. work[itaup], &vt[vt_offset], ldvt, &work[
  2627. iwork], &i__2, &ierr);
  2628. /* Generate left bidiagonalizing vectors in U */
  2629. /* (Workspace: need 4*M, prefer 3*M+M*NB) */
  2630. i__2 = *lwork - iwork + 1;
  2631. _starpu_dorgbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
  2632. &work[iwork], &i__2, &ierr);
  2633. iwork = ie + *m;
  2634. /* Perform bidiagonal QR iteration, computing left */
  2635. /* singular vectors of A in U and computing right */
  2636. /* singular vectors of A in VT */
  2637. /* (Workspace: need BDSPAC) */
  2638. _starpu_dbdsqr_("U", m, n, m, &c__0, &s[1], &work[ie], &vt[
  2639. vt_offset], ldvt, &u[u_offset], ldu, dum, &
  2640. c__1, &work[iwork], info);
  2641. }
  2642. }
  2643. } else if (wntva) {
  2644. if (wntun) {
  2645. /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */
  2646. /* N right singular vectors to be computed in VT and */
  2647. /* no left singular vectors to be computed */
  2648. /* Computing MAX */
  2649. i__2 = *n + *m, i__3 = *m << 2, i__2 = max(i__2,i__3);
  2650. if (*lwork >= *m * *m + max(i__2,bdspac)) {
  2651. /* Sufficient workspace for a fast algorithm */
  2652. ir = 1;
  2653. if (*lwork >= wrkbl + *lda * *m) {
  2654. /* WORK(IR) is LDA by M */
  2655. ldwrkr = *lda;
  2656. } else {
  2657. /* WORK(IR) is M by M */
  2658. ldwrkr = *m;
  2659. }
  2660. itau = ir + ldwrkr * *m;
  2661. iwork = itau + *m;
  2662. /* Compute A=L*Q, copying result to VT */
  2663. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2664. i__2 = *lwork - iwork + 1;
  2665. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2666. iwork], &i__2, &ierr);
  2667. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2668. ldvt);
  2669. /* Copy L to WORK(IR), zeroing out above it */
  2670. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &
  2671. ldwrkr);
  2672. i__2 = *m - 1;
  2673. i__3 = *m - 1;
  2674. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &work[ir
  2675. + ldwrkr], &ldwrkr);
  2676. /* Generate Q in VT */
  2677. /* (Workspace: need M*M+M+N, prefer M*M+M+N*NB) */
  2678. i__2 = *lwork - iwork + 1;
  2679. _starpu_dorglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2680. work[iwork], &i__2, &ierr);
  2681. ie = itau;
  2682. itauq = ie + *m;
  2683. itaup = itauq + *m;
  2684. iwork = itaup + *m;
  2685. /* Bidiagonalize L in WORK(IR) */
  2686. /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
  2687. i__2 = *lwork - iwork + 1;
  2688. _starpu_dgebrd_(m, m, &work[ir], &ldwrkr, &s[1], &work[ie], &
  2689. work[itauq], &work[itaup], &work[iwork], &
  2690. i__2, &ierr);
  2691. /* Generate right bidiagonalizing vectors in WORK(IR) */
  2692. /* (Workspace: need M*M+4*M-1, */
  2693. /* prefer M*M+3*M+(M-1)*NB) */
  2694. i__2 = *lwork - iwork + 1;
  2695. _starpu_dorgbr_("P", m, m, m, &work[ir], &ldwrkr, &work[itaup]
  2696. , &work[iwork], &i__2, &ierr);
  2697. iwork = ie + *m;
  2698. /* Perform bidiagonal QR iteration, computing right */
  2699. /* singular vectors of L in WORK(IR) */
  2700. /* (Workspace: need M*M+BDSPAC) */
  2701. _starpu_dbdsqr_("U", m, m, &c__0, &c__0, &s[1], &work[ie], &
  2702. work[ir], &ldwrkr, dum, &c__1, dum, &c__1, &
  2703. work[iwork], info);
  2704. /* Multiply right singular vectors of L in WORK(IR) by */
  2705. /* Q in VT, storing result in A */
  2706. /* (Workspace: need M*M) */
  2707. _starpu_dgemm_("N", "N", m, n, m, &c_b443, &work[ir], &ldwrkr,
  2708. &vt[vt_offset], ldvt, &c_b421, &a[a_offset],
  2709. lda);
  2710. /* Copy right singular vectors of A from A to VT */
  2711. _starpu_dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset],
  2712. ldvt);
  2713. } else {
  2714. /* Insufficient workspace for a fast algorithm */
  2715. itau = 1;
  2716. iwork = itau + *m;
  2717. /* Compute A=L*Q, copying result to VT */
  2718. /* (Workspace: need 2*M, prefer M+M*NB) */
  2719. i__2 = *lwork - iwork + 1;
  2720. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2721. iwork], &i__2, &ierr);
  2722. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2723. ldvt);
  2724. /* Generate Q in VT */
  2725. /* (Workspace: need M+N, prefer M+N*NB) */
  2726. i__2 = *lwork - iwork + 1;
  2727. _starpu_dorglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2728. work[iwork], &i__2, &ierr);
  2729. ie = itau;
  2730. itauq = ie + *m;
  2731. itaup = itauq + *m;
  2732. iwork = itaup + *m;
  2733. /* Zero out above L in A */
  2734. i__2 = *m - 1;
  2735. i__3 = *m - 1;
  2736. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &a[(
  2737. a_dim1 << 1) + 1], lda);
  2738. /* Bidiagonalize L in A */
  2739. /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
  2740. i__2 = *lwork - iwork + 1;
  2741. _starpu_dgebrd_(m, m, &a[a_offset], lda, &s[1], &work[ie], &
  2742. work[itauq], &work[itaup], &work[iwork], &
  2743. i__2, &ierr);
  2744. /* Multiply right bidiagonalizing vectors in A by Q */
  2745. /* in VT */
  2746. /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
  2747. i__2 = *lwork - iwork + 1;
  2748. _starpu_dormbr_("P", "L", "T", m, n, m, &a[a_offset], lda, &
  2749. work[itaup], &vt[vt_offset], ldvt, &work[
  2750. iwork], &i__2, &ierr);
  2751. iwork = ie + *m;
  2752. /* Perform bidiagonal QR iteration, computing right */
  2753. /* singular vectors of A in VT */
  2754. /* (Workspace: need BDSPAC) */
  2755. _starpu_dbdsqr_("U", m, n, &c__0, &c__0, &s[1], &work[ie], &
  2756. vt[vt_offset], ldvt, dum, &c__1, dum, &c__1, &
  2757. work[iwork], info);
  2758. }
  2759. } else if (wntuo) {
  2760. /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */
  2761. /* N right singular vectors to be computed in VT and */
  2762. /* M left singular vectors to be overwritten on A */
  2763. /* Computing MAX */
  2764. i__2 = *n + *m, i__3 = *m << 2, i__2 = max(i__2,i__3);
  2765. if (*lwork >= (*m << 1) * *m + max(i__2,bdspac)) {
  2766. /* Sufficient workspace for a fast algorithm */
  2767. iu = 1;
  2768. if (*lwork >= wrkbl + (*lda << 1) * *m) {
  2769. /* WORK(IU) is LDA by M and WORK(IR) is LDA by M */
  2770. ldwrku = *lda;
  2771. ir = iu + ldwrku * *m;
  2772. ldwrkr = *lda;
  2773. } else if (*lwork >= wrkbl + (*lda + *m) * *m) {
  2774. /* WORK(IU) is LDA by M and WORK(IR) is M by M */
  2775. ldwrku = *lda;
  2776. ir = iu + ldwrku * *m;
  2777. ldwrkr = *m;
  2778. } else {
  2779. /* WORK(IU) is M by M and WORK(IR) is M by M */
  2780. ldwrku = *m;
  2781. ir = iu + ldwrku * *m;
  2782. ldwrkr = *m;
  2783. }
  2784. itau = ir + ldwrkr * *m;
  2785. iwork = itau + *m;
  2786. /* Compute A=L*Q, copying result to VT */
  2787. /* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */
  2788. i__2 = *lwork - iwork + 1;
  2789. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2790. iwork], &i__2, &ierr);
  2791. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2792. ldvt);
  2793. /* Generate Q in VT */
  2794. /* (Workspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB) */
  2795. i__2 = *lwork - iwork + 1;
  2796. _starpu_dorglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2797. work[iwork], &i__2, &ierr);
  2798. /* Copy L to WORK(IU), zeroing out above it */
  2799. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &
  2800. ldwrku);
  2801. i__2 = *m - 1;
  2802. i__3 = *m - 1;
  2803. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &work[iu
  2804. + ldwrku], &ldwrku);
  2805. ie = itau;
  2806. itauq = ie + *m;
  2807. itaup = itauq + *m;
  2808. iwork = itaup + *m;
  2809. /* Bidiagonalize L in WORK(IU), copying result to */
  2810. /* WORK(IR) */
  2811. /* (Workspace: need 2*M*M+4*M, */
  2812. /* prefer 2*M*M+3*M+2*M*NB) */
  2813. i__2 = *lwork - iwork + 1;
  2814. _starpu_dgebrd_(m, m, &work[iu], &ldwrku, &s[1], &work[ie], &
  2815. work[itauq], &work[itaup], &work[iwork], &
  2816. i__2, &ierr);
  2817. _starpu_dlacpy_("L", m, m, &work[iu], &ldwrku, &work[ir], &
  2818. ldwrkr);
  2819. /* Generate right bidiagonalizing vectors in WORK(IU) */
  2820. /* (Workspace: need 2*M*M+4*M-1, */
  2821. /* prefer 2*M*M+3*M+(M-1)*NB) */
  2822. i__2 = *lwork - iwork + 1;
  2823. _starpu_dorgbr_("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
  2824. , &work[iwork], &i__2, &ierr);
  2825. /* Generate left bidiagonalizing vectors in WORK(IR) */
  2826. /* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB) */
  2827. i__2 = *lwork - iwork + 1;
  2828. _starpu_dorgbr_("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq]
  2829. , &work[iwork], &i__2, &ierr);
  2830. iwork = ie + *m;
  2831. /* Perform bidiagonal QR iteration, computing left */
  2832. /* singular vectors of L in WORK(IR) and computing */
  2833. /* right singular vectors of L in WORK(IU) */
  2834. /* (Workspace: need 2*M*M+BDSPAC) */
  2835. _starpu_dbdsqr_("U", m, m, m, &c__0, &s[1], &work[ie], &work[
  2836. iu], &ldwrku, &work[ir], &ldwrkr, dum, &c__1,
  2837. &work[iwork], info);
  2838. /* Multiply right singular vectors of L in WORK(IU) by */
  2839. /* Q in VT, storing result in A */
  2840. /* (Workspace: need M*M) */
  2841. _starpu_dgemm_("N", "N", m, n, m, &c_b443, &work[iu], &ldwrku,
  2842. &vt[vt_offset], ldvt, &c_b421, &a[a_offset],
  2843. lda);
  2844. /* Copy right singular vectors of A from A to VT */
  2845. _starpu_dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset],
  2846. ldvt);
  2847. /* Copy left singular vectors of A from WORK(IR) to A */
  2848. _starpu_dlacpy_("F", m, m, &work[ir], &ldwrkr, &a[a_offset],
  2849. lda);
  2850. } else {
  2851. /* Insufficient workspace for a fast algorithm */
  2852. itau = 1;
  2853. iwork = itau + *m;
  2854. /* Compute A=L*Q, copying result to VT */
  2855. /* (Workspace: need 2*M, prefer M+M*NB) */
  2856. i__2 = *lwork - iwork + 1;
  2857. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2858. iwork], &i__2, &ierr);
  2859. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2860. ldvt);
  2861. /* Generate Q in VT */
  2862. /* (Workspace: need M+N, prefer M+N*NB) */
  2863. i__2 = *lwork - iwork + 1;
  2864. _starpu_dorglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2865. work[iwork], &i__2, &ierr);
  2866. ie = itau;
  2867. itauq = ie + *m;
  2868. itaup = itauq + *m;
  2869. iwork = itaup + *m;
  2870. /* Zero out above L in A */
  2871. i__2 = *m - 1;
  2872. i__3 = *m - 1;
  2873. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &a[(
  2874. a_dim1 << 1) + 1], lda);
  2875. /* Bidiagonalize L in A */
  2876. /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
  2877. i__2 = *lwork - iwork + 1;
  2878. _starpu_dgebrd_(m, m, &a[a_offset], lda, &s[1], &work[ie], &
  2879. work[itauq], &work[itaup], &work[iwork], &
  2880. i__2, &ierr);
  2881. /* Multiply right bidiagonalizing vectors in A by Q */
  2882. /* in VT */
  2883. /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
  2884. i__2 = *lwork - iwork + 1;
  2885. _starpu_dormbr_("P", "L", "T", m, n, m, &a[a_offset], lda, &
  2886. work[itaup], &vt[vt_offset], ldvt, &work[
  2887. iwork], &i__2, &ierr);
  2888. /* Generate left bidiagonalizing vectors in A */
  2889. /* (Workspace: need 4*M, prefer 3*M+M*NB) */
  2890. i__2 = *lwork - iwork + 1;
  2891. _starpu_dorgbr_("Q", m, m, m, &a[a_offset], lda, &work[itauq],
  2892. &work[iwork], &i__2, &ierr);
  2893. iwork = ie + *m;
  2894. /* Perform bidiagonal QR iteration, computing left */
  2895. /* singular vectors of A in A and computing right */
  2896. /* singular vectors of A in VT */
  2897. /* (Workspace: need BDSPAC) */
  2898. _starpu_dbdsqr_("U", m, n, m, &c__0, &s[1], &work[ie], &vt[
  2899. vt_offset], ldvt, &a[a_offset], lda, dum, &
  2900. c__1, &work[iwork], info);
  2901. }
  2902. } else if (wntuas) {
  2903. /* Path 9t(N much larger than M, JOBU='S' or 'A', */
  2904. /* JOBVT='A') */
  2905. /* N right singular vectors to be computed in VT and */
  2906. /* M left singular vectors to be computed in U */
  2907. /* Computing MAX */
  2908. i__2 = *n + *m, i__3 = *m << 2, i__2 = max(i__2,i__3);
  2909. if (*lwork >= *m * *m + max(i__2,bdspac)) {
  2910. /* Sufficient workspace for a fast algorithm */
  2911. iu = 1;
  2912. if (*lwork >= wrkbl + *lda * *m) {
  2913. /* WORK(IU) is LDA by M */
  2914. ldwrku = *lda;
  2915. } else {
  2916. /* WORK(IU) is M by M */
  2917. ldwrku = *m;
  2918. }
  2919. itau = iu + ldwrku * *m;
  2920. iwork = itau + *m;
  2921. /* Compute A=L*Q, copying result to VT */
  2922. /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2923. i__2 = *lwork - iwork + 1;
  2924. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2925. iwork], &i__2, &ierr);
  2926. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2927. ldvt);
  2928. /* Generate Q in VT */
  2929. /* (Workspace: need M*M+M+N, prefer M*M+M+N*NB) */
  2930. i__2 = *lwork - iwork + 1;
  2931. _starpu_dorglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2932. work[iwork], &i__2, &ierr);
  2933. /* Copy L to WORK(IU), zeroing out above it */
  2934. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &
  2935. ldwrku);
  2936. i__2 = *m - 1;
  2937. i__3 = *m - 1;
  2938. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &work[iu
  2939. + ldwrku], &ldwrku);
  2940. ie = itau;
  2941. itauq = ie + *m;
  2942. itaup = itauq + *m;
  2943. iwork = itaup + *m;
  2944. /* Bidiagonalize L in WORK(IU), copying result to U */
  2945. /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
  2946. i__2 = *lwork - iwork + 1;
  2947. _starpu_dgebrd_(m, m, &work[iu], &ldwrku, &s[1], &work[ie], &
  2948. work[itauq], &work[itaup], &work[iwork], &
  2949. i__2, &ierr);
  2950. _starpu_dlacpy_("L", m, m, &work[iu], &ldwrku, &u[u_offset],
  2951. ldu);
  2952. /* Generate right bidiagonalizing vectors in WORK(IU) */
  2953. /* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB) */
  2954. i__2 = *lwork - iwork + 1;
  2955. _starpu_dorgbr_("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
  2956. , &work[iwork], &i__2, &ierr);
  2957. /* Generate left bidiagonalizing vectors in U */
  2958. /* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) */
  2959. i__2 = *lwork - iwork + 1;
  2960. _starpu_dorgbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
  2961. &work[iwork], &i__2, &ierr);
  2962. iwork = ie + *m;
  2963. /* Perform bidiagonal QR iteration, computing left */
  2964. /* singular vectors of L in U and computing right */
  2965. /* singular vectors of L in WORK(IU) */
  2966. /* (Workspace: need M*M+BDSPAC) */
  2967. _starpu_dbdsqr_("U", m, m, m, &c__0, &s[1], &work[ie], &work[
  2968. iu], &ldwrku, &u[u_offset], ldu, dum, &c__1, &
  2969. work[iwork], info);
  2970. /* Multiply right singular vectors of L in WORK(IU) by */
  2971. /* Q in VT, storing result in A */
  2972. /* (Workspace: need M*M) */
  2973. _starpu_dgemm_("N", "N", m, n, m, &c_b443, &work[iu], &ldwrku,
  2974. &vt[vt_offset], ldvt, &c_b421, &a[a_offset],
  2975. lda);
  2976. /* Copy right singular vectors of A from A to VT */
  2977. _starpu_dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset],
  2978. ldvt);
  2979. } else {
  2980. /* Insufficient workspace for a fast algorithm */
  2981. itau = 1;
  2982. iwork = itau + *m;
  2983. /* Compute A=L*Q, copying result to VT */
  2984. /* (Workspace: need 2*M, prefer M+M*NB) */
  2985. i__2 = *lwork - iwork + 1;
  2986. _starpu_dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2987. iwork], &i__2, &ierr);
  2988. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2989. ldvt);
  2990. /* Generate Q in VT */
  2991. /* (Workspace: need M+N, prefer M+N*NB) */
  2992. i__2 = *lwork - iwork + 1;
  2993. _starpu_dorglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2994. work[iwork], &i__2, &ierr);
  2995. /* Copy L to U, zeroing out above it */
  2996. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset],
  2997. ldu);
  2998. i__2 = *m - 1;
  2999. i__3 = *m - 1;
  3000. _starpu_dlaset_("U", &i__2, &i__3, &c_b421, &c_b421, &u[(
  3001. u_dim1 << 1) + 1], ldu);
  3002. ie = itau;
  3003. itauq = ie + *m;
  3004. itaup = itauq + *m;
  3005. iwork = itaup + *m;
  3006. /* Bidiagonalize L in U */
  3007. /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
  3008. i__2 = *lwork - iwork + 1;
  3009. _starpu_dgebrd_(m, m, &u[u_offset], ldu, &s[1], &work[ie], &
  3010. work[itauq], &work[itaup], &work[iwork], &
  3011. i__2, &ierr);
  3012. /* Multiply right bidiagonalizing vectors in U by Q */
  3013. /* in VT */
  3014. /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
  3015. i__2 = *lwork - iwork + 1;
  3016. _starpu_dormbr_("P", "L", "T", m, n, m, &u[u_offset], ldu, &
  3017. work[itaup], &vt[vt_offset], ldvt, &work[
  3018. iwork], &i__2, &ierr);
  3019. /* Generate left bidiagonalizing vectors in U */
  3020. /* (Workspace: need 4*M, prefer 3*M+M*NB) */
  3021. i__2 = *lwork - iwork + 1;
  3022. _starpu_dorgbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
  3023. &work[iwork], &i__2, &ierr);
  3024. iwork = ie + *m;
  3025. /* Perform bidiagonal QR iteration, computing left */
  3026. /* singular vectors of A in U and computing right */
  3027. /* singular vectors of A in VT */
  3028. /* (Workspace: need BDSPAC) */
  3029. _starpu_dbdsqr_("U", m, n, m, &c__0, &s[1], &work[ie], &vt[
  3030. vt_offset], ldvt, &u[u_offset], ldu, dum, &
  3031. c__1, &work[iwork], info);
  3032. }
  3033. }
  3034. }
  3035. } else {
  3036. /* N .LT. MNTHR */
  3037. /* Path 10t(N greater than M, but not much larger) */
  3038. /* Reduce to bidiagonal form without LQ decomposition */
  3039. ie = 1;
  3040. itauq = ie + *m;
  3041. itaup = itauq + *m;
  3042. iwork = itaup + *m;
  3043. /* Bidiagonalize A */
  3044. /* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) */
  3045. i__2 = *lwork - iwork + 1;
  3046. _starpu_dgebrd_(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
  3047. work[itaup], &work[iwork], &i__2, &ierr);
  3048. if (wntuas) {
  3049. /* If left singular vectors desired in U, copy result to U */
  3050. /* and generate left bidiagonalizing vectors in U */
  3051. /* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB) */
  3052. _starpu_dlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
  3053. i__2 = *lwork - iwork + 1;
  3054. _starpu_dorgbr_("Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[
  3055. iwork], &i__2, &ierr);
  3056. }
  3057. if (wntvas) {
  3058. /* If right singular vectors desired in VT, copy result to */
  3059. /* VT and generate right bidiagonalizing vectors in VT */
  3060. /* (Workspace: need 3*M+NRVT, prefer 3*M+NRVT*NB) */
  3061. _starpu_dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
  3062. if (wntva) {
  3063. nrvt = *n;
  3064. }
  3065. if (wntvs) {
  3066. nrvt = *m;
  3067. }
  3068. i__2 = *lwork - iwork + 1;
  3069. _starpu_dorgbr_("P", &nrvt, n, m, &vt[vt_offset], ldvt, &work[itaup],
  3070. &work[iwork], &i__2, &ierr);
  3071. }
  3072. if (wntuo) {
  3073. /* If left singular vectors desired in A, generate left */
  3074. /* bidiagonalizing vectors in A */
  3075. /* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB) */
  3076. i__2 = *lwork - iwork + 1;
  3077. _starpu_dorgbr_("Q", m, m, n, &a[a_offset], lda, &work[itauq], &work[
  3078. iwork], &i__2, &ierr);
  3079. }
  3080. if (wntvo) {
  3081. /* If right singular vectors desired in A, generate right */
  3082. /* bidiagonalizing vectors in A */
  3083. /* (Workspace: need 4*M, prefer 3*M+M*NB) */
  3084. i__2 = *lwork - iwork + 1;
  3085. _starpu_dorgbr_("P", m, n, m, &a[a_offset], lda, &work[itaup], &work[
  3086. iwork], &i__2, &ierr);
  3087. }
  3088. iwork = ie + *m;
  3089. if (wntuas || wntuo) {
  3090. nru = *m;
  3091. }
  3092. if (wntun) {
  3093. nru = 0;
  3094. }
  3095. if (wntvas || wntvo) {
  3096. ncvt = *n;
  3097. }
  3098. if (wntvn) {
  3099. ncvt = 0;
  3100. }
  3101. if (! wntuo && ! wntvo) {
  3102. /* Perform bidiagonal QR iteration, if desired, computing */
  3103. /* left singular vectors in U and computing right singular */
  3104. /* vectors in VT */
  3105. /* (Workspace: need BDSPAC) */
  3106. _starpu_dbdsqr_("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[
  3107. vt_offset], ldvt, &u[u_offset], ldu, dum, &c__1, &
  3108. work[iwork], info);
  3109. } else if (! wntuo && wntvo) {
  3110. /* Perform bidiagonal QR iteration, if desired, computing */
  3111. /* left singular vectors in U and computing right singular */
  3112. /* vectors in A */
  3113. /* (Workspace: need BDSPAC) */
  3114. _starpu_dbdsqr_("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &a[
  3115. a_offset], lda, &u[u_offset], ldu, dum, &c__1, &work[
  3116. iwork], info);
  3117. } else {
  3118. /* Perform bidiagonal QR iteration, if desired, computing */
  3119. /* left singular vectors in A and computing right singular */
  3120. /* vectors in VT */
  3121. /* (Workspace: need BDSPAC) */
  3122. _starpu_dbdsqr_("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[
  3123. vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, &
  3124. work[iwork], info);
  3125. }
  3126. }
  3127. }
  3128. /* If DBDSQR failed to converge, copy unconverged superdiagonals */
  3129. /* to WORK( 2:MINMN ) */
  3130. if (*info != 0) {
  3131. if (ie > 2) {
  3132. i__2 = minmn - 1;
  3133. for (i__ = 1; i__ <= i__2; ++i__) {
  3134. work[i__ + 1] = work[i__ + ie - 1];
  3135. /* L50: */
  3136. }
  3137. }
  3138. if (ie < 2) {
  3139. for (i__ = minmn - 1; i__ >= 1; --i__) {
  3140. work[i__ + 1] = work[i__ + ie - 1];
  3141. /* L60: */
  3142. }
  3143. }
  3144. }
  3145. /* Undo scaling if necessary */
  3146. if (iscl == 1) {
  3147. if (anrm > bignum) {
  3148. _starpu_dlascl_("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &
  3149. minmn, &ierr);
  3150. }
  3151. if (*info != 0 && anrm > bignum) {
  3152. i__2 = minmn - 1;
  3153. _starpu_dlascl_("G", &c__0, &c__0, &bignum, &anrm, &i__2, &c__1, &work[2],
  3154. &minmn, &ierr);
  3155. }
  3156. if (anrm < smlnum) {
  3157. _starpu_dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &
  3158. minmn, &ierr);
  3159. }
  3160. if (*info != 0 && anrm < smlnum) {
  3161. i__2 = minmn - 1;
  3162. _starpu_dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &i__2, &c__1, &work[2],
  3163. &minmn, &ierr);
  3164. }
  3165. }
  3166. /* Return optimal workspace in WORK(1) */
  3167. work[1] = (doublereal) maxwrk;
  3168. return 0;
  3169. /* End of DGESVD */
  3170. } /* _starpu_dgesvd_ */