You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

zgesvd.c 150 kB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730
  1. #include <math.h>
  2. #include <stdlib.h>
  3. #include <string.h>
  4. #include <stdio.h>
  5. #include <complex.h>
  6. #ifdef complex
  7. #undef complex
  8. #endif
  9. #ifdef I
  10. #undef I
  11. #endif
  12. #if defined(_WIN64)
  13. typedef long long BLASLONG;
  14. typedef unsigned long long BLASULONG;
  15. #else
  16. typedef long BLASLONG;
  17. typedef unsigned long BLASULONG;
  18. #endif
  19. #ifdef LAPACK_ILP64
  20. typedef BLASLONG blasint;
  21. #if defined(_WIN64)
  22. #define blasabs(x) llabs(x)
  23. #else
  24. #define blasabs(x) labs(x)
  25. #endif
  26. #else
  27. typedef int blasint;
  28. #define blasabs(x) abs(x)
  29. #endif
  30. typedef blasint integer;
  31. typedef unsigned int uinteger;
  32. typedef char *address;
  33. typedef short int shortint;
  34. typedef float real;
  35. typedef double doublereal;
  36. typedef struct { real r, i; } complex;
  37. typedef struct { doublereal r, i; } doublecomplex;
  38. #ifdef _MSC_VER
  39. static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;}
  40. static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;}
  41. static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;}
  42. static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;}
  43. #else
  44. static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;}
  45. static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;}
  46. static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;}
  47. static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;}
  48. #endif
  49. #define pCf(z) (*_pCf(z))
  50. #define pCd(z) (*_pCd(z))
  51. typedef int logical;
  52. typedef short int shortlogical;
  53. typedef char logical1;
  54. typedef char integer1;
  55. #define TRUE_ (1)
  56. #define FALSE_ (0)
  57. /* Extern is for use with -E */
  58. #ifndef Extern
  59. #define Extern extern
  60. #endif
  61. /* I/O stuff */
  62. typedef int flag;
  63. typedef int ftnlen;
  64. typedef int ftnint;
  65. /*external read, write*/
  66. typedef struct
  67. { flag cierr;
  68. ftnint ciunit;
  69. flag ciend;
  70. char *cifmt;
  71. ftnint cirec;
  72. } cilist;
  73. /*internal read, write*/
  74. typedef struct
  75. { flag icierr;
  76. char *iciunit;
  77. flag iciend;
  78. char *icifmt;
  79. ftnint icirlen;
  80. ftnint icirnum;
  81. } icilist;
  82. /*open*/
  83. typedef struct
  84. { flag oerr;
  85. ftnint ounit;
  86. char *ofnm;
  87. ftnlen ofnmlen;
  88. char *osta;
  89. char *oacc;
  90. char *ofm;
  91. ftnint orl;
  92. char *oblnk;
  93. } olist;
  94. /*close*/
  95. typedef struct
  96. { flag cerr;
  97. ftnint cunit;
  98. char *csta;
  99. } cllist;
  100. /*rewind, backspace, endfile*/
  101. typedef struct
  102. { flag aerr;
  103. ftnint aunit;
  104. } alist;
  105. /* inquire */
  106. typedef struct
  107. { flag inerr;
  108. ftnint inunit;
  109. char *infile;
  110. ftnlen infilen;
  111. ftnint *inex; /*parameters in standard's order*/
  112. ftnint *inopen;
  113. ftnint *innum;
  114. ftnint *innamed;
  115. char *inname;
  116. ftnlen innamlen;
  117. char *inacc;
  118. ftnlen inacclen;
  119. char *inseq;
  120. ftnlen inseqlen;
  121. char *indir;
  122. ftnlen indirlen;
  123. char *infmt;
  124. ftnlen infmtlen;
  125. char *inform;
  126. ftnint informlen;
  127. char *inunf;
  128. ftnlen inunflen;
  129. ftnint *inrecl;
  130. ftnint *innrec;
  131. char *inblank;
  132. ftnlen inblanklen;
  133. } inlist;
  134. #define VOID void
  135. union Multitype { /* for multiple entry points */
  136. integer1 g;
  137. shortint h;
  138. integer i;
  139. /* longint j; */
  140. real r;
  141. doublereal d;
  142. complex c;
  143. doublecomplex z;
  144. };
  145. typedef union Multitype Multitype;
  146. struct Vardesc { /* for Namelist */
  147. char *name;
  148. char *addr;
  149. ftnlen *dims;
  150. int type;
  151. };
  152. typedef struct Vardesc Vardesc;
  153. struct Namelist {
  154. char *name;
  155. Vardesc **vars;
  156. int nvars;
  157. };
  158. typedef struct Namelist Namelist;
  159. #define abs(x) ((x) >= 0 ? (x) : -(x))
  160. #define dabs(x) (fabs(x))
  161. #define f2cmin(a,b) ((a) <= (b) ? (a) : (b))
  162. #define f2cmax(a,b) ((a) >= (b) ? (a) : (b))
  163. #define dmin(a,b) (f2cmin(a,b))
  164. #define dmax(a,b) (f2cmax(a,b))
  165. #define bit_test(a,b) ((a) >> (b) & 1)
  166. #define bit_clear(a,b) ((a) & ~((uinteger)1 << (b)))
  167. #define bit_set(a,b) ((a) | ((uinteger)1 << (b)))
  168. #define abort_() { sig_die("Fortran abort routine called", 1); }
  169. #define c_abs(z) (cabsf(Cf(z)))
  170. #define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); }
  171. #ifdef _MSC_VER
  172. #define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);}
  173. #define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/df(b)._Val[1]);}
  174. #else
  175. #define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);}
  176. #define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);}
  177. #endif
  178. #define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));}
  179. #define c_log(R, Z) {pCf(R) = clogf(Cf(Z));}
  180. #define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));}
  181. //#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));}
  182. #define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));}
  183. #define d_abs(x) (fabs(*(x)))
  184. #define d_acos(x) (acos(*(x)))
  185. #define d_asin(x) (asin(*(x)))
  186. #define d_atan(x) (atan(*(x)))
  187. #define d_atn2(x, y) (atan2(*(x),*(y)))
  188. #define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); }
  189. #define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); }
  190. #define d_cos(x) (cos(*(x)))
  191. #define d_cosh(x) (cosh(*(x)))
  192. #define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 )
  193. #define d_exp(x) (exp(*(x)))
  194. #define d_imag(z) (cimag(Cd(z)))
  195. #define r_imag(z) (cimagf(Cf(z)))
  196. #define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x)))
  197. #define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x)))
  198. #define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) )
  199. #define r_lg10(x) ( 0.43429448190325182765 * log(*(x)) )
  200. #define d_log(x) (log(*(x)))
  201. #define d_mod(x, y) (fmod(*(x), *(y)))
  202. #define u_nint(__x) ((__x)>=0 ? floor((__x) + .5) : -floor(.5 - (__x)))
  203. #define d_nint(x) u_nint(*(x))
  204. #define u_sign(__a,__b) ((__b) >= 0 ? ((__a) >= 0 ? (__a) : -(__a)) : -((__a) >= 0 ? (__a) : -(__a)))
  205. #define d_sign(a,b) u_sign(*(a),*(b))
  206. #define r_sign(a,b) u_sign(*(a),*(b))
  207. #define d_sin(x) (sin(*(x)))
  208. #define d_sinh(x) (sinh(*(x)))
  209. #define d_sqrt(x) (sqrt(*(x)))
  210. #define d_tan(x) (tan(*(x)))
  211. #define d_tanh(x) (tanh(*(x)))
  212. #define i_abs(x) abs(*(x))
  213. #define i_dnnt(x) ((integer)u_nint(*(x)))
  214. #define i_len(s, n) (n)
  215. #define i_nint(x) ((integer)u_nint(*(x)))
  216. #define i_sign(a,b) ((integer)u_sign((integer)*(a),(integer)*(b)))
  217. #define pow_dd(ap, bp) ( pow(*(ap), *(bp)))
  218. #define pow_si(B,E) spow_ui(*(B),*(E))
  219. #define pow_ri(B,E) spow_ui(*(B),*(E))
  220. #define pow_di(B,E) dpow_ui(*(B),*(E))
  221. #define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));}
  222. #define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));}
  223. #define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));}
  224. #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; }
  225. #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d))))
  226. #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; }
  227. #define sig_die(s, kill) { exit(1); }
  228. #define s_stop(s, n) {exit(0);}
  229. static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n";
  230. #define z_abs(z) (cabs(Cd(z)))
  231. #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));}
  232. #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));}
  233. #define myexit_() break;
  234. #define mycycle() continue;
  235. #define myceiling(w) {ceil(w)}
  236. #define myhuge(w) {HUGE_VAL}
  237. //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);}
  238. #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)}
  239. /* procedure parameter types for -A and -C++ */
  240. #define F2C_proc_par_types 1
  241. #ifdef __cplusplus
  242. typedef logical (*L_fp)(...);
  243. #else
  244. typedef logical (*L_fp)();
  245. #endif
  246. static float spow_ui(float x, integer n) {
  247. float pow=1.0; unsigned long int u;
  248. if(n != 0) {
  249. if(n < 0) n = -n, x = 1/x;
  250. for(u = n; ; ) {
  251. if(u & 01) pow *= x;
  252. if(u >>= 1) x *= x;
  253. else break;
  254. }
  255. }
  256. return pow;
  257. }
  258. static double dpow_ui(double x, integer n) {
  259. double pow=1.0; unsigned long int u;
  260. if(n != 0) {
  261. if(n < 0) n = -n, x = 1/x;
  262. for(u = n; ; ) {
  263. if(u & 01) pow *= x;
  264. if(u >>= 1) x *= x;
  265. else break;
  266. }
  267. }
  268. return pow;
  269. }
  270. #ifdef _MSC_VER
  271. static _Fcomplex cpow_ui(complex x, integer n) {
  272. complex pow={1.0,0.0}; unsigned long int u;
  273. if(n != 0) {
  274. if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i;
  275. for(u = n; ; ) {
  276. if(u & 01) pow.r *= x.r, pow.i *= x.i;
  277. if(u >>= 1) x.r *= x.r, x.i *= x.i;
  278. else break;
  279. }
  280. }
  281. _Fcomplex p={pow.r, pow.i};
  282. return p;
  283. }
  284. #else
  285. static _Complex float cpow_ui(_Complex float x, integer n) {
  286. _Complex float pow=1.0; unsigned long int u;
  287. if(n != 0) {
  288. if(n < 0) n = -n, x = 1/x;
  289. for(u = n; ; ) {
  290. if(u & 01) pow *= x;
  291. if(u >>= 1) x *= x;
  292. else break;
  293. }
  294. }
  295. return pow;
  296. }
  297. #endif
  298. #ifdef _MSC_VER
  299. static _Dcomplex zpow_ui(_Dcomplex x, integer n) {
  300. _Dcomplex pow={1.0,0.0}; unsigned long int u;
  301. if(n != 0) {
  302. if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1];
  303. for(u = n; ; ) {
  304. if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1];
  305. if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1];
  306. else break;
  307. }
  308. }
  309. _Dcomplex p = {pow._Val[0], pow._Val[1]};
  310. return p;
  311. }
  312. #else
  313. static _Complex double zpow_ui(_Complex double x, integer n) {
  314. _Complex double pow=1.0; unsigned long int u;
  315. if(n != 0) {
  316. if(n < 0) n = -n, x = 1/x;
  317. for(u = n; ; ) {
  318. if(u & 01) pow *= x;
  319. if(u >>= 1) x *= x;
  320. else break;
  321. }
  322. }
  323. return pow;
  324. }
  325. #endif
  326. static integer pow_ii(integer x, integer n) {
  327. integer pow; unsigned long int u;
  328. if (n <= 0) {
  329. if (n == 0 || x == 1) pow = 1;
  330. else if (x != -1) pow = x == 0 ? 1/x : 0;
  331. else n = -n;
  332. }
  333. if ((n > 0) || !(n == 0 || x == 1 || x != -1)) {
  334. u = n;
  335. for(pow = 1; ; ) {
  336. if(u & 01) pow *= x;
  337. if(u >>= 1) x *= x;
  338. else break;
  339. }
  340. }
  341. return pow;
  342. }
  343. static integer dmaxloc_(double *w, integer s, integer e, integer *n)
  344. {
  345. double m; integer i, mi;
  346. for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
  347. if (w[i-1]>m) mi=i ,m=w[i-1];
  348. return mi-s+1;
  349. }
  350. static integer smaxloc_(float *w, integer s, integer e, integer *n)
  351. {
  352. float m; integer i, mi;
  353. for(m=w[s-1], mi=s, i=s+1; i<=e; i++)
  354. if (w[i-1]>m) mi=i ,m=w[i-1];
  355. return mi-s+1;
  356. }
  357. static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
  358. integer n = *n_, incx = *incx_, incy = *incy_, i;
  359. #ifdef _MSC_VER
  360. _Fcomplex zdotc = {0.0, 0.0};
  361. if (incx == 1 && incy == 1) {
  362. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  363. zdotc._Val[0] += conjf(Cf(&x[i]))._Val[0] * Cf(&y[i])._Val[0];
  364. zdotc._Val[1] += conjf(Cf(&x[i]))._Val[1] * Cf(&y[i])._Val[1];
  365. }
  366. } else {
  367. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  368. zdotc._Val[0] += conjf(Cf(&x[i*incx]))._Val[0] * Cf(&y[i*incy])._Val[0];
  369. zdotc._Val[1] += conjf(Cf(&x[i*incx]))._Val[1] * Cf(&y[i*incy])._Val[1];
  370. }
  371. }
  372. pCf(z) = zdotc;
  373. }
  374. #else
  375. _Complex float zdotc = 0.0;
  376. if (incx == 1 && incy == 1) {
  377. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  378. zdotc += conjf(Cf(&x[i])) * Cf(&y[i]);
  379. }
  380. } else {
  381. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  382. zdotc += conjf(Cf(&x[i*incx])) * Cf(&y[i*incy]);
  383. }
  384. }
  385. pCf(z) = zdotc;
  386. }
  387. #endif
  388. static inline void zdotc_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
  389. integer n = *n_, incx = *incx_, incy = *incy_, i;
  390. #ifdef _MSC_VER
  391. _Dcomplex zdotc = {0.0, 0.0};
  392. if (incx == 1 && incy == 1) {
  393. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  394. zdotc._Val[0] += conj(Cd(&x[i]))._Val[0] * Cd(&y[i])._Val[0];
  395. zdotc._Val[1] += conj(Cd(&x[i]))._Val[1] * Cd(&y[i])._Val[1];
  396. }
  397. } else {
  398. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  399. zdotc._Val[0] += conj(Cd(&x[i*incx]))._Val[0] * Cd(&y[i*incy])._Val[0];
  400. zdotc._Val[1] += conj(Cd(&x[i*incx]))._Val[1] * Cd(&y[i*incy])._Val[1];
  401. }
  402. }
  403. pCd(z) = zdotc;
  404. }
  405. #else
  406. _Complex double zdotc = 0.0;
  407. if (incx == 1 && incy == 1) {
  408. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  409. zdotc += conj(Cd(&x[i])) * Cd(&y[i]);
  410. }
  411. } else {
  412. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  413. zdotc += conj(Cd(&x[i*incx])) * Cd(&y[i*incy]);
  414. }
  415. }
  416. pCd(z) = zdotc;
  417. }
  418. #endif
  419. static inline void cdotu_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) {
  420. integer n = *n_, incx = *incx_, incy = *incy_, i;
  421. #ifdef _MSC_VER
  422. _Fcomplex zdotc = {0.0, 0.0};
  423. if (incx == 1 && incy == 1) {
  424. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  425. zdotc._Val[0] += Cf(&x[i])._Val[0] * Cf(&y[i])._Val[0];
  426. zdotc._Val[1] += Cf(&x[i])._Val[1] * Cf(&y[i])._Val[1];
  427. }
  428. } else {
  429. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  430. zdotc._Val[0] += Cf(&x[i*incx])._Val[0] * Cf(&y[i*incy])._Val[0];
  431. zdotc._Val[1] += Cf(&x[i*incx])._Val[1] * Cf(&y[i*incy])._Val[1];
  432. }
  433. }
  434. pCf(z) = zdotc;
  435. }
  436. #else
  437. _Complex float zdotc = 0.0;
  438. if (incx == 1 && incy == 1) {
  439. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  440. zdotc += Cf(&x[i]) * Cf(&y[i]);
  441. }
  442. } else {
  443. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  444. zdotc += Cf(&x[i*incx]) * Cf(&y[i*incy]);
  445. }
  446. }
  447. pCf(z) = zdotc;
  448. }
  449. #endif
  450. static inline void zdotu_(doublecomplex *z, integer *n_, doublecomplex *x, integer *incx_, doublecomplex *y, integer *incy_) {
  451. integer n = *n_, incx = *incx_, incy = *incy_, i;
  452. #ifdef _MSC_VER
  453. _Dcomplex zdotc = {0.0, 0.0};
  454. if (incx == 1 && incy == 1) {
  455. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  456. zdotc._Val[0] += Cd(&x[i])._Val[0] * Cd(&y[i])._Val[0];
  457. zdotc._Val[1] += Cd(&x[i])._Val[1] * Cd(&y[i])._Val[1];
  458. }
  459. } else {
  460. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  461. zdotc._Val[0] += Cd(&x[i*incx])._Val[0] * Cd(&y[i*incy])._Val[0];
  462. zdotc._Val[1] += Cd(&x[i*incx])._Val[1] * Cd(&y[i*incy])._Val[1];
  463. }
  464. }
  465. pCd(z) = zdotc;
  466. }
  467. #else
  468. _Complex double zdotc = 0.0;
  469. if (incx == 1 && incy == 1) {
  470. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  471. zdotc += Cd(&x[i]) * Cd(&y[i]);
  472. }
  473. } else {
  474. for (i=0;i<n;i++) { /* zdotc = zdotc + dconjg(x(i))* y(i) */
  475. zdotc += Cd(&x[i*incx]) * Cd(&y[i*incy]);
  476. }
  477. }
  478. pCd(z) = zdotc;
  479. }
  480. #endif
  481. /* -- translated by f2c (version 20000121).
  482. You must link the resulting object file with the libraries:
  483. -lf2c -lm (in that order)
  484. */
  485. /* Table of constant values */
  486. static doublecomplex c_b1 = {0.,0.};
  487. static doublecomplex c_b2 = {1.,0.};
  488. static integer c__6 = 6;
  489. static integer c__0 = 0;
  490. static integer c__2 = 2;
  491. static integer c_n1 = -1;
  492. static integer c__1 = 1;
  493. /* > \brief <b> ZGESVD computes the singular value decomposition (SVD) for GE matrices</b> */
  494. /* =========== DOCUMENTATION =========== */
  495. /* Online html documentation available at */
  496. /* http://www.netlib.org/lapack/explore-html/ */
  497. /* > \htmlonly */
  498. /* > Download ZGESVD + dependencies */
  499. /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgesvd.
  500. f"> */
  501. /* > [TGZ]</a> */
  502. /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgesvd.
  503. f"> */
  504. /* > [ZIP]</a> */
  505. /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgesvd.
  506. f"> */
  507. /* > [TXT]</a> */
  508. /* > \endhtmlonly */
  509. /* Definition: */
  510. /* =========== */
  511. /* SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, */
  512. /* WORK, LWORK, RWORK, INFO ) */
  513. /* CHARACTER JOBU, JOBVT */
  514. /* INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N */
  515. /* DOUBLE PRECISION RWORK( * ), S( * ) */
  516. /* COMPLEX*16 A( LDA, * ), U( LDU, * ), VT( LDVT, * ), */
  517. /* $ WORK( * ) */
  518. /* > \par Purpose: */
  519. /* ============= */
  520. /* > */
  521. /* > \verbatim */
  522. /* > */
  523. /* > ZGESVD computes the singular value decomposition (SVD) of a complex */
  524. /* > M-by-N matrix A, optionally computing the left and/or right singular */
  525. /* > vectors. The SVD is written */
  526. /* > */
  527. /* > A = U * SIGMA * conjugate-transpose(V) */
  528. /* > */
  529. /* > where SIGMA is an M-by-N matrix which is zero except for its */
  530. /* > f2cmin(m,n) diagonal elements, U is an M-by-M unitary matrix, and */
  531. /* > V is an N-by-N unitary matrix. The diagonal elements of SIGMA */
  532. /* > are the singular values of A; they are real and non-negative, and */
  533. /* > are returned in descending order. The first f2cmin(m,n) columns of */
  534. /* > U and V are the left and right singular vectors of A. */
  535. /* > */
  536. /* > Note that the routine returns V**H, not V. */
  537. /* > \endverbatim */
  538. /* Arguments: */
  539. /* ========== */
  540. /* > \param[in] JOBU */
  541. /* > \verbatim */
  542. /* > JOBU is CHARACTER*1 */
  543. /* > Specifies options for computing all or part of the matrix U: */
  544. /* > = 'A': all M columns of U are returned in array U: */
  545. /* > = 'S': the first f2cmin(m,n) columns of U (the left singular */
  546. /* > vectors) are returned in the array U; */
  547. /* > = 'O': the first f2cmin(m,n) columns of U (the left singular */
  548. /* > vectors) are overwritten on the array A; */
  549. /* > = 'N': no columns of U (no left singular vectors) are */
  550. /* > computed. */
  551. /* > \endverbatim */
  552. /* > */
  553. /* > \param[in] JOBVT */
  554. /* > \verbatim */
  555. /* > JOBVT is CHARACTER*1 */
  556. /* > Specifies options for computing all or part of the matrix */
  557. /* > V**H: */
  558. /* > = 'A': all N rows of V**H are returned in the array VT; */
  559. /* > = 'S': the first f2cmin(m,n) rows of V**H (the right singular */
  560. /* > vectors) are returned in the array VT; */
  561. /* > = 'O': the first f2cmin(m,n) rows of V**H (the right singular */
  562. /* > vectors) are overwritten on the array A; */
  563. /* > = 'N': no rows of V**H (no right singular vectors) are */
  564. /* > computed. */
  565. /* > */
  566. /* > JOBVT and JOBU cannot both be 'O'. */
  567. /* > \endverbatim */
  568. /* > */
  569. /* > \param[in] M */
  570. /* > \verbatim */
  571. /* > M is INTEGER */
  572. /* > The number of rows of the input matrix A. M >= 0. */
  573. /* > \endverbatim */
  574. /* > */
  575. /* > \param[in] N */
  576. /* > \verbatim */
  577. /* > N is INTEGER */
  578. /* > The number of columns of the input matrix A. N >= 0. */
  579. /* > \endverbatim */
  580. /* > */
  581. /* > \param[in,out] A */
  582. /* > \verbatim */
  583. /* > A is COMPLEX*16 array, dimension (LDA,N) */
  584. /* > On entry, the M-by-N matrix A. */
  585. /* > On exit, */
  586. /* > if JOBU = 'O', A is overwritten with the first f2cmin(m,n) */
  587. /* > columns of U (the left singular vectors, */
  588. /* > stored columnwise); */
  589. /* > if JOBVT = 'O', A is overwritten with the first f2cmin(m,n) */
  590. /* > rows of V**H (the right singular vectors, */
  591. /* > stored rowwise); */
  592. /* > if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A */
  593. /* > are destroyed. */
  594. /* > \endverbatim */
  595. /* > */
  596. /* > \param[in] LDA */
  597. /* > \verbatim */
  598. /* > LDA is INTEGER */
  599. /* > The leading dimension of the array A. LDA >= f2cmax(1,M). */
  600. /* > \endverbatim */
  601. /* > */
  602. /* > \param[out] S */
  603. /* > \verbatim */
  604. /* > S is DOUBLE PRECISION array, dimension (f2cmin(M,N)) */
  605. /* > The singular values of A, sorted so that S(i) >= S(i+1). */
  606. /* > \endverbatim */
  607. /* > */
  608. /* > \param[out] U */
  609. /* > \verbatim */
  610. /* > U is COMPLEX*16 array, dimension (LDU,UCOL) */
  611. /* > (LDU,M) if JOBU = 'A' or (LDU,f2cmin(M,N)) if JOBU = 'S'. */
  612. /* > If JOBU = 'A', U contains the M-by-M unitary matrix U; */
  613. /* > if JOBU = 'S', U contains the first f2cmin(m,n) columns of U */
  614. /* > (the left singular vectors, stored columnwise); */
  615. /* > if JOBU = 'N' or 'O', U is not referenced. */
  616. /* > \endverbatim */
  617. /* > */
  618. /* > \param[in] LDU */
  619. /* > \verbatim */
  620. /* > LDU is INTEGER */
  621. /* > The leading dimension of the array U. LDU >= 1; if */
  622. /* > JOBU = 'S' or 'A', LDU >= M. */
  623. /* > \endverbatim */
  624. /* > */
  625. /* > \param[out] VT */
  626. /* > \verbatim */
  627. /* > VT is COMPLEX*16 array, dimension (LDVT,N) */
  628. /* > If JOBVT = 'A', VT contains the N-by-N unitary matrix */
  629. /* > V**H; */
  630. /* > if JOBVT = 'S', VT contains the first f2cmin(m,n) rows of */
  631. /* > V**H (the right singular vectors, stored rowwise); */
  632. /* > if JOBVT = 'N' or 'O', VT is not referenced. */
  633. /* > \endverbatim */
  634. /* > */
  635. /* > \param[in] LDVT */
  636. /* > \verbatim */
  637. /* > LDVT is INTEGER */
  638. /* > The leading dimension of the array VT. LDVT >= 1; if */
  639. /* > JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= f2cmin(M,N). */
  640. /* > \endverbatim */
  641. /* > */
  642. /* > \param[out] WORK */
  643. /* > \verbatim */
  644. /* > WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) */
  645. /* > On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
  646. /* > \endverbatim */
  647. /* > */
  648. /* > \param[in] LWORK */
  649. /* > \verbatim */
  650. /* > LWORK is INTEGER */
  651. /* > The dimension of the array WORK. */
  652. /* > LWORK >= MAX(1,2*MIN(M,N)+MAX(M,N)). */
  653. /* > For good performance, LWORK should generally be larger. */
  654. /* > */
  655. /* > If LWORK = -1, then a workspace query is assumed; the routine */
  656. /* > only calculates the optimal size of the WORK array, returns */
  657. /* > this value as the first entry of the WORK array, and no error */
  658. /* > message related to LWORK is issued by XERBLA. */
  659. /* > \endverbatim */
  660. /* > */
  661. /* > \param[out] RWORK */
  662. /* > \verbatim */
  663. /* > RWORK is DOUBLE PRECISION array, dimension (5*f2cmin(M,N)) */
  664. /* > On exit, if INFO > 0, RWORK(1:MIN(M,N)-1) contains the */
  665. /* > unconverged superdiagonal elements of an upper bidiagonal */
  666. /* > matrix B whose diagonal is in S (not necessarily sorted). */
  667. /* > B satisfies A = U * B * VT, so it has the same singular */
  668. /* > values as A, and singular vectors related by U and VT. */
  669. /* > \endverbatim */
  670. /* > */
  671. /* > \param[out] INFO */
  672. /* > \verbatim */
  673. /* > INFO is INTEGER */
  674. /* > = 0: successful exit. */
  675. /* > < 0: if INFO = -i, the i-th argument had an illegal value. */
  676. /* > > 0: if ZBDSQR did not converge, INFO specifies how many */
  677. /* > superdiagonals of an intermediate bidiagonal form B */
  678. /* > did not converge to zero. See the description of RWORK */
  679. /* > above for details. */
  680. /* > \endverbatim */
  681. /* Authors: */
  682. /* ======== */
  683. /* > \author Univ. of Tennessee */
  684. /* > \author Univ. of California Berkeley */
  685. /* > \author Univ. of Colorado Denver */
  686. /* > \author NAG Ltd. */
  687. /* > \date April 2012 */
  688. /* > \ingroup complex16GEsing */
  689. /* ===================================================================== */
  690. /* Subroutine */ int zgesvd_(char *jobu, char *jobvt, integer *m, integer *n,
  691. doublecomplex *a, integer *lda, doublereal *s, doublecomplex *u,
  692. integer *ldu, doublecomplex *vt, integer *ldvt, doublecomplex *work,
  693. integer *lwork, doublereal *rwork, integer *info)
  694. {
  695. /* System generated locals */
  696. address a__1[2];
  697. integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2],
  698. i__2, i__3, i__4;
  699. char ch__1[2];
  700. /* Local variables */
  701. doublecomplex cdum[1];
  702. integer iscl;
  703. doublereal anrm;
  704. integer ierr, itau, ncvt, nrvt, lwork_zgebrd__, lwork_zgelqf__, i__,
  705. lwork_zgeqrf__;
  706. extern logical lsame_(char *, char *);
  707. integer chunk, minmn;
  708. extern /* Subroutine */ int zgemm_(char *, char *, integer *, integer *,
  709. integer *, doublecomplex *, doublecomplex *, integer *,
  710. doublecomplex *, integer *, doublecomplex *, doublecomplex *,
  711. integer *);
  712. integer wrkbl, itaup, itauq, mnthr, iwork;
  713. logical wntua, wntva, wntun, wntuo, wntvn, wntvo, wntus, wntvs;
  714. integer ie;
  715. extern doublereal dlamch_(char *);
  716. integer ir, iu;
  717. extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
  718. doublereal *, doublereal *, integer *, integer *, doublereal *,
  719. integer *, integer *), xerbla_(char *, integer *, ftnlen),
  720. zgebrd_(integer *, integer *, doublecomplex *, integer *,
  721. doublereal *, doublereal *, doublecomplex *, doublecomplex *,
  722. doublecomplex *, integer *, integer *);
  723. extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
  724. integer *, integer *, ftnlen, ftnlen);
  725. extern doublereal zlange_(char *, integer *, integer *, doublecomplex *,
  726. integer *, doublereal *);
  727. doublereal bignum;
  728. extern /* Subroutine */ int zgelqf_(integer *, integer *, doublecomplex *,
  729. integer *, doublecomplex *, doublecomplex *, integer *, integer *
  730. ), zlascl_(char *, integer *, integer *, doublereal *, doublereal
  731. *, integer *, integer *, doublecomplex *, integer *, integer *), zgeqrf_(integer *, integer *, doublecomplex *, integer *,
  732. doublecomplex *, doublecomplex *, integer *, integer *), zlacpy_(
  733. char *, integer *, integer *, doublecomplex *, integer *,
  734. doublecomplex *, integer *), zlaset_(char *, integer *,
  735. integer *, doublecomplex *, doublecomplex *, doublecomplex *,
  736. integer *);
  737. integer ldwrkr;
  738. extern /* Subroutine */ int zbdsqr_(char *, integer *, integer *, integer
  739. *, integer *, doublereal *, doublereal *, doublecomplex *,
  740. integer *, doublecomplex *, integer *, doublecomplex *, integer *,
  741. doublereal *, integer *);
  742. integer minwrk, ldwrku, maxwrk;
  743. extern /* Subroutine */ int zungbr_(char *, integer *, integer *, integer
  744. *, doublecomplex *, integer *, doublecomplex *, doublecomplex *,
  745. integer *, integer *);
  746. doublereal smlnum;
  747. integer irwork;
  748. extern /* Subroutine */ int zunmbr_(char *, char *, char *, integer *,
  749. integer *, integer *, doublecomplex *, integer *, doublecomplex *,
  750. doublecomplex *, integer *, doublecomplex *, integer *, integer *
  751. ), zunglq_(integer *, integer *, integer *
  752. , doublecomplex *, integer *, doublecomplex *, doublecomplex *,
  753. integer *, integer *);
  754. logical lquery, wntuas, wntvas;
  755. extern /* Subroutine */ int zungqr_(integer *, integer *, integer *,
  756. doublecomplex *, integer *, doublecomplex *, doublecomplex *,
  757. integer *, integer *);
  758. integer blk, lwork_zungbr_p__, lwork_zungbr_q__, ncu;
  759. doublereal dum[1];
  760. integer lwork_zunglq_m__, lwork_zunglq_n__;
  761. doublereal eps;
  762. integer lwork_zungqr_m__, lwork_zungqr_n__, nru;
  763. /* -- LAPACK driver routine (version 3.7.0) -- */
  764. /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
  765. /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
  766. /* April 2012 */
  767. /* ===================================================================== */
  768. /* Test the input arguments */
  769. /* Parameter adjustments */
  770. a_dim1 = *lda;
  771. a_offset = 1 + a_dim1 * 1;
  772. a -= a_offset;
  773. --s;
  774. u_dim1 = *ldu;
  775. u_offset = 1 + u_dim1 * 1;
  776. u -= u_offset;
  777. vt_dim1 = *ldvt;
  778. vt_offset = 1 + vt_dim1 * 1;
  779. vt -= vt_offset;
  780. --work;
  781. --rwork;
  782. /* Function Body */
  783. *info = 0;
  784. minmn = f2cmin(*m,*n);
  785. wntua = lsame_(jobu, "A");
  786. wntus = lsame_(jobu, "S");
  787. wntuas = wntua || wntus;
  788. wntuo = lsame_(jobu, "O");
  789. wntun = lsame_(jobu, "N");
  790. wntva = lsame_(jobvt, "A");
  791. wntvs = lsame_(jobvt, "S");
  792. wntvas = wntva || wntvs;
  793. wntvo = lsame_(jobvt, "O");
  794. wntvn = lsame_(jobvt, "N");
  795. lquery = *lwork == -1;
  796. if (! (wntua || wntus || wntuo || wntun)) {
  797. *info = -1;
  798. } else if (! (wntva || wntvs || wntvo || wntvn) || wntvo && wntuo) {
  799. *info = -2;
  800. } else if (*m < 0) {
  801. *info = -3;
  802. } else if (*n < 0) {
  803. *info = -4;
  804. } else if (*lda < f2cmax(1,*m)) {
  805. *info = -6;
  806. } else if (*ldu < 1 || wntuas && *ldu < *m) {
  807. *info = -9;
  808. } else if (*ldvt < 1 || wntva && *ldvt < *n || wntvs && *ldvt < minmn) {
  809. *info = -11;
  810. }
  811. /* Compute workspace */
  812. /* (Note: Comments in the code beginning "Workspace:" describe the */
  813. /* minimal amount of workspace needed at that point in the code, */
  814. /* as well as the preferred amount for good performance. */
  815. /* CWorkspace refers to complex workspace, and RWorkspace to */
  816. /* real workspace. NB refers to the optimal block size for the */
  817. /* immediately following subroutine, as returned by ILAENV.) */
  818. if (*info == 0) {
  819. minwrk = 1;
  820. maxwrk = 1;
  821. if (*m >= *n && minmn > 0) {
  822. /* Space needed for ZBDSQR is BDSPAC = 5*N */
  823. /* Writing concatenation */
  824. i__1[0] = 1, a__1[0] = jobu;
  825. i__1[1] = 1, a__1[1] = jobvt;
  826. s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
  827. mnthr = ilaenv_(&c__6, "ZGESVD", ch__1, m, n, &c__0, &c__0, (
  828. ftnlen)6, (ftnlen)2);
  829. /* Compute space needed for ZGEQRF */
  830. zgeqrf_(m, n, &a[a_offset], lda, cdum, cdum, &c_n1, &ierr);
  831. lwork_zgeqrf__ = (integer) cdum[0].r;
  832. /* Compute space needed for ZUNGQR */
  833. zungqr_(m, n, n, &a[a_offset], lda, cdum, cdum, &c_n1, &ierr);
  834. lwork_zungqr_n__ = (integer) cdum[0].r;
  835. zungqr_(m, m, n, &a[a_offset], lda, cdum, cdum, &c_n1, &ierr);
  836. lwork_zungqr_m__ = (integer) cdum[0].r;
  837. /* Compute space needed for ZGEBRD */
  838. zgebrd_(n, n, &a[a_offset], lda, &s[1], dum, cdum, cdum, cdum, &
  839. c_n1, &ierr);
  840. lwork_zgebrd__ = (integer) cdum[0].r;
  841. /* Compute space needed for ZUNGBR */
  842. zungbr_("P", n, n, n, &a[a_offset], lda, cdum, cdum, &c_n1, &ierr);
  843. lwork_zungbr_p__ = (integer) cdum[0].r;
  844. zungbr_("Q", n, n, n, &a[a_offset], lda, cdum, cdum, &c_n1, &ierr);
  845. lwork_zungbr_q__ = (integer) cdum[0].r;
  846. if (*m >= mnthr) {
  847. if (wntun) {
  848. /* Path 1 (M much larger than N, JOBU='N') */
  849. maxwrk = *n + lwork_zgeqrf__;
  850. /* Computing MAX */
  851. i__2 = maxwrk, i__3 = (*n << 1) + lwork_zgebrd__;
  852. maxwrk = f2cmax(i__2,i__3);
  853. if (wntvo || wntvas) {
  854. /* Computing MAX */
  855. i__2 = maxwrk, i__3 = (*n << 1) + lwork_zungbr_p__;
  856. maxwrk = f2cmax(i__2,i__3);
  857. }
  858. minwrk = *n * 3;
  859. } else if (wntuo && wntvn) {
  860. /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */
  861. wrkbl = *n + lwork_zgeqrf__;
  862. /* Computing MAX */
  863. i__2 = wrkbl, i__3 = *n + lwork_zungqr_n__;
  864. wrkbl = f2cmax(i__2,i__3);
  865. /* Computing MAX */
  866. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zgebrd__;
  867. wrkbl = f2cmax(i__2,i__3);
  868. /* Computing MAX */
  869. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_q__;
  870. wrkbl = f2cmax(i__2,i__3);
  871. /* Computing MAX */
  872. i__2 = *n * *n + wrkbl, i__3 = *n * *n + *m * *n;
  873. maxwrk = f2cmax(i__2,i__3);
  874. minwrk = (*n << 1) + *m;
  875. } else if (wntuo && wntvas) {
  876. /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or */
  877. /* 'A') */
  878. wrkbl = *n + lwork_zgeqrf__;
  879. /* Computing MAX */
  880. i__2 = wrkbl, i__3 = *n + lwork_zungqr_n__;
  881. wrkbl = f2cmax(i__2,i__3);
  882. /* Computing MAX */
  883. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zgebrd__;
  884. wrkbl = f2cmax(i__2,i__3);
  885. /* Computing MAX */
  886. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_q__;
  887. wrkbl = f2cmax(i__2,i__3);
  888. /* Computing MAX */
  889. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_p__;
  890. wrkbl = f2cmax(i__2,i__3);
  891. /* Computing MAX */
  892. i__2 = *n * *n + wrkbl, i__3 = *n * *n + *m * *n;
  893. maxwrk = f2cmax(i__2,i__3);
  894. minwrk = (*n << 1) + *m;
  895. } else if (wntus && wntvn) {
  896. /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */
  897. wrkbl = *n + lwork_zgeqrf__;
  898. /* Computing MAX */
  899. i__2 = wrkbl, i__3 = *n + lwork_zungqr_n__;
  900. wrkbl = f2cmax(i__2,i__3);
  901. /* Computing MAX */
  902. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zgebrd__;
  903. wrkbl = f2cmax(i__2,i__3);
  904. /* Computing MAX */
  905. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_q__;
  906. wrkbl = f2cmax(i__2,i__3);
  907. maxwrk = *n * *n + wrkbl;
  908. minwrk = (*n << 1) + *m;
  909. } else if (wntus && wntvo) {
  910. /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */
  911. wrkbl = *n + lwork_zgeqrf__;
  912. /* Computing MAX */
  913. i__2 = wrkbl, i__3 = *n + lwork_zungqr_n__;
  914. wrkbl = f2cmax(i__2,i__3);
  915. /* Computing MAX */
  916. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zgebrd__;
  917. wrkbl = f2cmax(i__2,i__3);
  918. /* Computing MAX */
  919. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_q__;
  920. wrkbl = f2cmax(i__2,i__3);
  921. /* Computing MAX */
  922. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_p__;
  923. wrkbl = f2cmax(i__2,i__3);
  924. maxwrk = (*n << 1) * *n + wrkbl;
  925. minwrk = (*n << 1) + *m;
  926. } else if (wntus && wntvas) {
  927. /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or */
  928. /* 'A') */
  929. wrkbl = *n + lwork_zgeqrf__;
  930. /* Computing MAX */
  931. i__2 = wrkbl, i__3 = *n + lwork_zungqr_n__;
  932. wrkbl = f2cmax(i__2,i__3);
  933. /* Computing MAX */
  934. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zgebrd__;
  935. wrkbl = f2cmax(i__2,i__3);
  936. /* Computing MAX */
  937. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_q__;
  938. wrkbl = f2cmax(i__2,i__3);
  939. /* Computing MAX */
  940. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_p__;
  941. wrkbl = f2cmax(i__2,i__3);
  942. maxwrk = *n * *n + wrkbl;
  943. minwrk = (*n << 1) + *m;
  944. } else if (wntua && wntvn) {
  945. /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */
  946. wrkbl = *n + lwork_zgeqrf__;
  947. /* Computing MAX */
  948. i__2 = wrkbl, i__3 = *n + lwork_zungqr_m__;
  949. wrkbl = f2cmax(i__2,i__3);
  950. /* Computing MAX */
  951. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zgebrd__;
  952. wrkbl = f2cmax(i__2,i__3);
  953. /* Computing MAX */
  954. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_q__;
  955. wrkbl = f2cmax(i__2,i__3);
  956. maxwrk = *n * *n + wrkbl;
  957. minwrk = (*n << 1) + *m;
  958. } else if (wntua && wntvo) {
  959. /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */
  960. wrkbl = *n + lwork_zgeqrf__;
  961. /* Computing MAX */
  962. i__2 = wrkbl, i__3 = *n + lwork_zungqr_m__;
  963. wrkbl = f2cmax(i__2,i__3);
  964. /* Computing MAX */
  965. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zgebrd__;
  966. wrkbl = f2cmax(i__2,i__3);
  967. /* Computing MAX */
  968. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_q__;
  969. wrkbl = f2cmax(i__2,i__3);
  970. /* Computing MAX */
  971. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_p__;
  972. wrkbl = f2cmax(i__2,i__3);
  973. maxwrk = (*n << 1) * *n + wrkbl;
  974. minwrk = (*n << 1) + *m;
  975. } else if (wntua && wntvas) {
  976. /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or */
  977. /* 'A') */
  978. wrkbl = *n + lwork_zgeqrf__;
  979. /* Computing MAX */
  980. i__2 = wrkbl, i__3 = *n + lwork_zungqr_m__;
  981. wrkbl = f2cmax(i__2,i__3);
  982. /* Computing MAX */
  983. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zgebrd__;
  984. wrkbl = f2cmax(i__2,i__3);
  985. /* Computing MAX */
  986. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_q__;
  987. wrkbl = f2cmax(i__2,i__3);
  988. /* Computing MAX */
  989. i__2 = wrkbl, i__3 = (*n << 1) + lwork_zungbr_p__;
  990. wrkbl = f2cmax(i__2,i__3);
  991. maxwrk = *n * *n + wrkbl;
  992. minwrk = (*n << 1) + *m;
  993. }
  994. } else {
  995. /* Path 10 (M at least N, but not much larger) */
  996. zgebrd_(m, n, &a[a_offset], lda, &s[1], dum, cdum, cdum, cdum,
  997. &c_n1, &ierr);
  998. lwork_zgebrd__ = (integer) cdum[0].r;
  999. maxwrk = (*n << 1) + lwork_zgebrd__;
  1000. if (wntus || wntuo) {
  1001. zungbr_("Q", m, n, n, &a[a_offset], lda, cdum, cdum, &
  1002. c_n1, &ierr);
  1003. lwork_zungbr_q__ = (integer) cdum[0].r;
  1004. /* Computing MAX */
  1005. i__2 = maxwrk, i__3 = (*n << 1) + lwork_zungbr_q__;
  1006. maxwrk = f2cmax(i__2,i__3);
  1007. }
  1008. if (wntua) {
  1009. zungbr_("Q", m, m, n, &a[a_offset], lda, cdum, cdum, &
  1010. c_n1, &ierr);
  1011. lwork_zungbr_q__ = (integer) cdum[0].r;
  1012. /* Computing MAX */
  1013. i__2 = maxwrk, i__3 = (*n << 1) + lwork_zungbr_q__;
  1014. maxwrk = f2cmax(i__2,i__3);
  1015. }
  1016. if (! wntvn) {
  1017. /* Computing MAX */
  1018. i__2 = maxwrk, i__3 = (*n << 1) + lwork_zungbr_p__;
  1019. maxwrk = f2cmax(i__2,i__3);
  1020. }
  1021. minwrk = (*n << 1) + *m;
  1022. }
  1023. } else if (minmn > 0) {
  1024. /* Space needed for ZBDSQR is BDSPAC = 5*M */
  1025. /* Writing concatenation */
  1026. i__1[0] = 1, a__1[0] = jobu;
  1027. i__1[1] = 1, a__1[1] = jobvt;
  1028. s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
  1029. mnthr = ilaenv_(&c__6, "ZGESVD", ch__1, m, n, &c__0, &c__0, (
  1030. ftnlen)6, (ftnlen)2);
  1031. /* Compute space needed for ZGELQF */
  1032. zgelqf_(m, n, &a[a_offset], lda, cdum, cdum, &c_n1, &ierr);
  1033. lwork_zgelqf__ = (integer) cdum[0].r;
  1034. /* Compute space needed for ZUNGLQ */
  1035. zunglq_(n, n, m, cdum, n, cdum, cdum, &c_n1, &ierr);
  1036. lwork_zunglq_n__ = (integer) cdum[0].r;
  1037. zunglq_(m, n, m, &a[a_offset], lda, cdum, cdum, &c_n1, &ierr);
  1038. lwork_zunglq_m__ = (integer) cdum[0].r;
  1039. /* Compute space needed for ZGEBRD */
  1040. zgebrd_(m, m, &a[a_offset], lda, &s[1], dum, cdum, cdum, cdum, &
  1041. c_n1, &ierr);
  1042. lwork_zgebrd__ = (integer) cdum[0].r;
  1043. /* Compute space needed for ZUNGBR P */
  1044. zungbr_("P", m, m, m, &a[a_offset], n, cdum, cdum, &c_n1, &ierr);
  1045. lwork_zungbr_p__ = (integer) cdum[0].r;
  1046. /* Compute space needed for ZUNGBR Q */
  1047. zungbr_("Q", m, m, m, &a[a_offset], n, cdum, cdum, &c_n1, &ierr);
  1048. lwork_zungbr_q__ = (integer) cdum[0].r;
  1049. if (*n >= mnthr) {
  1050. if (wntvn) {
  1051. /* Path 1t(N much larger than M, JOBVT='N') */
  1052. maxwrk = *m + lwork_zgelqf__;
  1053. /* Computing MAX */
  1054. i__2 = maxwrk, i__3 = (*m << 1) + lwork_zgebrd__;
  1055. maxwrk = f2cmax(i__2,i__3);
  1056. if (wntuo || wntuas) {
  1057. /* Computing MAX */
  1058. i__2 = maxwrk, i__3 = (*m << 1) + lwork_zungbr_q__;
  1059. maxwrk = f2cmax(i__2,i__3);
  1060. }
  1061. minwrk = *m * 3;
  1062. } else if (wntvo && wntun) {
  1063. /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */
  1064. wrkbl = *m + lwork_zgelqf__;
  1065. /* Computing MAX */
  1066. i__2 = wrkbl, i__3 = *m + lwork_zunglq_m__;
  1067. wrkbl = f2cmax(i__2,i__3);
  1068. /* Computing MAX */
  1069. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zgebrd__;
  1070. wrkbl = f2cmax(i__2,i__3);
  1071. /* Computing MAX */
  1072. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_p__;
  1073. wrkbl = f2cmax(i__2,i__3);
  1074. /* Computing MAX */
  1075. i__2 = *m * *m + wrkbl, i__3 = *m * *m + *m * *n;
  1076. maxwrk = f2cmax(i__2,i__3);
  1077. minwrk = (*m << 1) + *n;
  1078. } else if (wntvo && wntuas) {
  1079. /* Path 3t(N much larger than M, JOBU='S' or 'A', */
  1080. /* JOBVT='O') */
  1081. wrkbl = *m + lwork_zgelqf__;
  1082. /* Computing MAX */
  1083. i__2 = wrkbl, i__3 = *m + lwork_zunglq_m__;
  1084. wrkbl = f2cmax(i__2,i__3);
  1085. /* Computing MAX */
  1086. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zgebrd__;
  1087. wrkbl = f2cmax(i__2,i__3);
  1088. /* Computing MAX */
  1089. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_p__;
  1090. wrkbl = f2cmax(i__2,i__3);
  1091. /* Computing MAX */
  1092. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_q__;
  1093. wrkbl = f2cmax(i__2,i__3);
  1094. /* Computing MAX */
  1095. i__2 = *m * *m + wrkbl, i__3 = *m * *m + *m * *n;
  1096. maxwrk = f2cmax(i__2,i__3);
  1097. minwrk = (*m << 1) + *n;
  1098. } else if (wntvs && wntun) {
  1099. /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */
  1100. wrkbl = *m + lwork_zgelqf__;
  1101. /* Computing MAX */
  1102. i__2 = wrkbl, i__3 = *m + lwork_zunglq_m__;
  1103. wrkbl = f2cmax(i__2,i__3);
  1104. /* Computing MAX */
  1105. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zgebrd__;
  1106. wrkbl = f2cmax(i__2,i__3);
  1107. /* Computing MAX */
  1108. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_p__;
  1109. wrkbl = f2cmax(i__2,i__3);
  1110. maxwrk = *m * *m + wrkbl;
  1111. minwrk = (*m << 1) + *n;
  1112. } else if (wntvs && wntuo) {
  1113. /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */
  1114. wrkbl = *m + lwork_zgelqf__;
  1115. /* Computing MAX */
  1116. i__2 = wrkbl, i__3 = *m + lwork_zunglq_m__;
  1117. wrkbl = f2cmax(i__2,i__3);
  1118. /* Computing MAX */
  1119. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zgebrd__;
  1120. wrkbl = f2cmax(i__2,i__3);
  1121. /* Computing MAX */
  1122. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_p__;
  1123. wrkbl = f2cmax(i__2,i__3);
  1124. /* Computing MAX */
  1125. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_q__;
  1126. wrkbl = f2cmax(i__2,i__3);
  1127. maxwrk = (*m << 1) * *m + wrkbl;
  1128. minwrk = (*m << 1) + *n;
  1129. } else if (wntvs && wntuas) {
  1130. /* Path 6t(N much larger than M, JOBU='S' or 'A', */
  1131. /* JOBVT='S') */
  1132. wrkbl = *m + lwork_zgelqf__;
  1133. /* Computing MAX */
  1134. i__2 = wrkbl, i__3 = *m + lwork_zunglq_m__;
  1135. wrkbl = f2cmax(i__2,i__3);
  1136. /* Computing MAX */
  1137. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zgebrd__;
  1138. wrkbl = f2cmax(i__2,i__3);
  1139. /* Computing MAX */
  1140. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_p__;
  1141. wrkbl = f2cmax(i__2,i__3);
  1142. /* Computing MAX */
  1143. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_q__;
  1144. wrkbl = f2cmax(i__2,i__3);
  1145. maxwrk = *m * *m + wrkbl;
  1146. minwrk = (*m << 1) + *n;
  1147. } else if (wntva && wntun) {
  1148. /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */
  1149. wrkbl = *m + lwork_zgelqf__;
  1150. /* Computing MAX */
  1151. i__2 = wrkbl, i__3 = *m + lwork_zunglq_n__;
  1152. wrkbl = f2cmax(i__2,i__3);
  1153. /* Computing MAX */
  1154. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zgebrd__;
  1155. wrkbl = f2cmax(i__2,i__3);
  1156. /* Computing MAX */
  1157. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_p__;
  1158. wrkbl = f2cmax(i__2,i__3);
  1159. maxwrk = *m * *m + wrkbl;
  1160. minwrk = (*m << 1) + *n;
  1161. } else if (wntva && wntuo) {
  1162. /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */
  1163. wrkbl = *m + lwork_zgelqf__;
  1164. /* Computing MAX */
  1165. i__2 = wrkbl, i__3 = *m + lwork_zunglq_n__;
  1166. wrkbl = f2cmax(i__2,i__3);
  1167. /* Computing MAX */
  1168. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zgebrd__;
  1169. wrkbl = f2cmax(i__2,i__3);
  1170. /* Computing MAX */
  1171. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_p__;
  1172. wrkbl = f2cmax(i__2,i__3);
  1173. /* Computing MAX */
  1174. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_q__;
  1175. wrkbl = f2cmax(i__2,i__3);
  1176. maxwrk = (*m << 1) * *m + wrkbl;
  1177. minwrk = (*m << 1) + *n;
  1178. } else if (wntva && wntuas) {
  1179. /* Path 9t(N much larger than M, JOBU='S' or 'A', */
  1180. /* JOBVT='A') */
  1181. wrkbl = *m + lwork_zgelqf__;
  1182. /* Computing MAX */
  1183. i__2 = wrkbl, i__3 = *m + lwork_zunglq_n__;
  1184. wrkbl = f2cmax(i__2,i__3);
  1185. /* Computing MAX */
  1186. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zgebrd__;
  1187. wrkbl = f2cmax(i__2,i__3);
  1188. /* Computing MAX */
  1189. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_p__;
  1190. wrkbl = f2cmax(i__2,i__3);
  1191. /* Computing MAX */
  1192. i__2 = wrkbl, i__3 = (*m << 1) + lwork_zungbr_q__;
  1193. wrkbl = f2cmax(i__2,i__3);
  1194. maxwrk = *m * *m + wrkbl;
  1195. minwrk = (*m << 1) + *n;
  1196. }
  1197. } else {
  1198. /* Path 10t(N greater than M, but not much larger) */
  1199. zgebrd_(m, n, &a[a_offset], lda, &s[1], dum, cdum, cdum, cdum,
  1200. &c_n1, &ierr);
  1201. lwork_zgebrd__ = (integer) cdum[0].r;
  1202. maxwrk = (*m << 1) + lwork_zgebrd__;
  1203. if (wntvs || wntvo) {
  1204. /* Compute space needed for ZUNGBR P */
  1205. zungbr_("P", m, n, m, &a[a_offset], n, cdum, cdum, &c_n1,
  1206. &ierr);
  1207. lwork_zungbr_p__ = (integer) cdum[0].r;
  1208. /* Computing MAX */
  1209. i__2 = maxwrk, i__3 = (*m << 1) + lwork_zungbr_p__;
  1210. maxwrk = f2cmax(i__2,i__3);
  1211. }
  1212. if (wntva) {
  1213. zungbr_("P", n, n, m, &a[a_offset], n, cdum, cdum, &c_n1,
  1214. &ierr);
  1215. lwork_zungbr_p__ = (integer) cdum[0].r;
  1216. /* Computing MAX */
  1217. i__2 = maxwrk, i__3 = (*m << 1) + lwork_zungbr_p__;
  1218. maxwrk = f2cmax(i__2,i__3);
  1219. }
  1220. if (! wntun) {
  1221. /* Computing MAX */
  1222. i__2 = maxwrk, i__3 = (*m << 1) + lwork_zungbr_q__;
  1223. maxwrk = f2cmax(i__2,i__3);
  1224. }
  1225. minwrk = (*m << 1) + *n;
  1226. }
  1227. }
  1228. maxwrk = f2cmax(maxwrk,minwrk);
  1229. work[1].r = (doublereal) maxwrk, work[1].i = 0.;
  1230. if (*lwork < minwrk && ! lquery) {
  1231. *info = -13;
  1232. }
  1233. }
  1234. if (*info != 0) {
  1235. i__2 = -(*info);
  1236. xerbla_("ZGESVD", &i__2, (ftnlen)6);
  1237. return 0;
  1238. } else if (lquery) {
  1239. return 0;
  1240. }
  1241. /* Quick return if possible */
  1242. if (*m == 0 || *n == 0) {
  1243. return 0;
  1244. }
  1245. /* Get machine constants */
  1246. eps = dlamch_("P");
  1247. smlnum = sqrt(dlamch_("S")) / eps;
  1248. bignum = 1. / smlnum;
  1249. /* Scale A if f2cmax element outside range [SMLNUM,BIGNUM] */
  1250. anrm = zlange_("M", m, n, &a[a_offset], lda, dum);
  1251. iscl = 0;
  1252. if (anrm > 0. && anrm < smlnum) {
  1253. iscl = 1;
  1254. zlascl_("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &
  1255. ierr);
  1256. } else if (anrm > bignum) {
  1257. iscl = 1;
  1258. zlascl_("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda, &
  1259. ierr);
  1260. }
  1261. if (*m >= *n) {
  1262. /* A has at least as many rows as columns. If A has sufficiently */
  1263. /* more rows than columns, first reduce using the QR */
  1264. /* decomposition (if sufficient workspace available) */
  1265. if (*m >= mnthr) {
  1266. if (wntun) {
  1267. /* Path 1 (M much larger than N, JOBU='N') */
  1268. /* No left singular vectors to be computed */
  1269. itau = 1;
  1270. iwork = itau + *n;
  1271. /* Compute A=Q*R */
  1272. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  1273. /* (RWorkspace: need 0) */
  1274. i__2 = *lwork - iwork + 1;
  1275. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &
  1276. i__2, &ierr);
  1277. /* Zero out below R */
  1278. if (*n > 1) {
  1279. i__2 = *n - 1;
  1280. i__3 = *n - 1;
  1281. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &a[a_dim1 + 2],
  1282. lda);
  1283. }
  1284. ie = 1;
  1285. itauq = 1;
  1286. itaup = itauq + *n;
  1287. iwork = itaup + *n;
  1288. /* Bidiagonalize R in A */
  1289. /* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) */
  1290. /* (RWorkspace: need N) */
  1291. i__2 = *lwork - iwork + 1;
  1292. zgebrd_(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[
  1293. itauq], &work[itaup], &work[iwork], &i__2, &ierr);
  1294. ncvt = 0;
  1295. if (wntvo || wntvas) {
  1296. /* If right singular vectors desired, generate P'. */
  1297. /* (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) */
  1298. /* (RWorkspace: 0) */
  1299. i__2 = *lwork - iwork + 1;
  1300. zungbr_("P", n, n, n, &a[a_offset], lda, &work[itaup], &
  1301. work[iwork], &i__2, &ierr);
  1302. ncvt = *n;
  1303. }
  1304. irwork = ie + *n;
  1305. /* Perform bidiagonal QR iteration, computing right */
  1306. /* singular vectors of A in A if desired */
  1307. /* (CWorkspace: 0) */
  1308. /* (RWorkspace: need BDSPAC) */
  1309. zbdsqr_("U", n, &ncvt, &c__0, &c__0, &s[1], &rwork[ie], &a[
  1310. a_offset], lda, cdum, &c__1, cdum, &c__1, &rwork[
  1311. irwork], info);
  1312. /* If right singular vectors desired in VT, copy them there */
  1313. if (wntvas) {
  1314. zlacpy_("F", n, n, &a[a_offset], lda, &vt[vt_offset],
  1315. ldvt);
  1316. }
  1317. } else if (wntuo && wntvn) {
  1318. /* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */
  1319. /* N left singular vectors to be overwritten on A and */
  1320. /* no right singular vectors to be computed */
  1321. if (*lwork >= *n * *n + *n * 3) {
  1322. /* Sufficient workspace for a fast algorithm */
  1323. ir = 1;
  1324. /* Computing MAX */
  1325. i__2 = wrkbl, i__3 = *lda * *n;
  1326. if (*lwork >= f2cmax(i__2,i__3) + *lda * *n) {
  1327. /* WORK(IU) is LDA by N, WORK(IR) is LDA by N */
  1328. ldwrku = *lda;
  1329. ldwrkr = *lda;
  1330. } else /* if(complicated condition) */ {
  1331. /* Computing MAX */
  1332. i__2 = wrkbl, i__3 = *lda * *n;
  1333. if (*lwork >= f2cmax(i__2,i__3) + *n * *n) {
  1334. /* WORK(IU) is LDA by N, WORK(IR) is N by N */
  1335. ldwrku = *lda;
  1336. ldwrkr = *n;
  1337. } else {
  1338. /* WORK(IU) is LDWRKU by N, WORK(IR) is N by N */
  1339. ldwrku = (*lwork - *n * *n) / *n;
  1340. ldwrkr = *n;
  1341. }
  1342. }
  1343. itau = ir + ldwrkr * *n;
  1344. iwork = itau + *n;
  1345. /* Compute A=Q*R */
  1346. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1347. /* (RWorkspace: 0) */
  1348. i__2 = *lwork - iwork + 1;
  1349. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  1350. , &i__2, &ierr);
  1351. /* Copy R to WORK(IR) and zero out below it */
  1352. zlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
  1353. i__2 = *n - 1;
  1354. i__3 = *n - 1;
  1355. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &work[ir + 1], &
  1356. ldwrkr);
  1357. /* Generate Q in A */
  1358. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1359. /* (RWorkspace: 0) */
  1360. i__2 = *lwork - iwork + 1;
  1361. zungqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[
  1362. iwork], &i__2, &ierr);
  1363. ie = 1;
  1364. itauq = itau;
  1365. itaup = itauq + *n;
  1366. iwork = itaup + *n;
  1367. /* Bidiagonalize R in WORK(IR) */
  1368. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) */
  1369. /* (RWorkspace: need N) */
  1370. i__2 = *lwork - iwork + 1;
  1371. zgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
  1372. work[itauq], &work[itaup], &work[iwork], &i__2, &
  1373. ierr);
  1374. /* Generate left vectors bidiagonalizing R */
  1375. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) */
  1376. /* (RWorkspace: need 0) */
  1377. i__2 = *lwork - iwork + 1;
  1378. zungbr_("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &
  1379. work[iwork], &i__2, &ierr);
  1380. irwork = ie + *n;
  1381. /* Perform bidiagonal QR iteration, computing left */
  1382. /* singular vectors of R in WORK(IR) */
  1383. /* (CWorkspace: need N*N) */
  1384. /* (RWorkspace: need BDSPAC) */
  1385. zbdsqr_("U", n, &c__0, n, &c__0, &s[1], &rwork[ie], cdum,
  1386. &c__1, &work[ir], &ldwrkr, cdum, &c__1, &rwork[
  1387. irwork], info);
  1388. iu = itauq;
  1389. /* Multiply Q in A by left singular vectors of R in */
  1390. /* WORK(IR), storing result in WORK(IU) and copying to A */
  1391. /* (CWorkspace: need N*N+N, prefer N*N+M*N) */
  1392. /* (RWorkspace: 0) */
  1393. i__2 = *m;
  1394. i__3 = ldwrku;
  1395. for (i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
  1396. i__3) {
  1397. /* Computing MIN */
  1398. i__4 = *m - i__ + 1;
  1399. chunk = f2cmin(i__4,ldwrku);
  1400. zgemm_("N", "N", &chunk, n, n, &c_b2, &a[i__ + a_dim1]
  1401. , lda, &work[ir], &ldwrkr, &c_b1, &work[iu], &
  1402. ldwrku);
  1403. zlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ +
  1404. a_dim1], lda);
  1405. /* L10: */
  1406. }
  1407. } else {
  1408. /* Insufficient workspace for a fast algorithm */
  1409. ie = 1;
  1410. itauq = 1;
  1411. itaup = itauq + *n;
  1412. iwork = itaup + *n;
  1413. /* Bidiagonalize A */
  1414. /* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) */
  1415. /* (RWorkspace: N) */
  1416. i__3 = *lwork - iwork + 1;
  1417. zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[
  1418. itauq], &work[itaup], &work[iwork], &i__3, &ierr);
  1419. /* Generate left vectors bidiagonalizing A */
  1420. /* (CWorkspace: need 3*N, prefer 2*N+N*NB) */
  1421. /* (RWorkspace: 0) */
  1422. i__3 = *lwork - iwork + 1;
  1423. zungbr_("Q", m, n, n, &a[a_offset], lda, &work[itauq], &
  1424. work[iwork], &i__3, &ierr);
  1425. irwork = ie + *n;
  1426. /* Perform bidiagonal QR iteration, computing left */
  1427. /* singular vectors of A in A */
  1428. /* (CWorkspace: need 0) */
  1429. /* (RWorkspace: need BDSPAC) */
  1430. zbdsqr_("U", n, &c__0, m, &c__0, &s[1], &rwork[ie], cdum,
  1431. &c__1, &a[a_offset], lda, cdum, &c__1, &rwork[
  1432. irwork], info);
  1433. }
  1434. } else if (wntuo && wntvas) {
  1435. /* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A') */
  1436. /* N left singular vectors to be overwritten on A and */
  1437. /* N right singular vectors to be computed in VT */
  1438. if (*lwork >= *n * *n + *n * 3) {
  1439. /* Sufficient workspace for a fast algorithm */
  1440. ir = 1;
  1441. /* Computing MAX */
  1442. i__3 = wrkbl, i__2 = *lda * *n;
  1443. if (*lwork >= f2cmax(i__3,i__2) + *lda * *n) {
  1444. /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */
  1445. ldwrku = *lda;
  1446. ldwrkr = *lda;
  1447. } else /* if(complicated condition) */ {
  1448. /* Computing MAX */
  1449. i__3 = wrkbl, i__2 = *lda * *n;
  1450. if (*lwork >= f2cmax(i__3,i__2) + *n * *n) {
  1451. /* WORK(IU) is LDA by N and WORK(IR) is N by N */
  1452. ldwrku = *lda;
  1453. ldwrkr = *n;
  1454. } else {
  1455. /* WORK(IU) is LDWRKU by N and WORK(IR) is N by N */
  1456. ldwrku = (*lwork - *n * *n) / *n;
  1457. ldwrkr = *n;
  1458. }
  1459. }
  1460. itau = ir + ldwrkr * *n;
  1461. iwork = itau + *n;
  1462. /* Compute A=Q*R */
  1463. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1464. /* (RWorkspace: 0) */
  1465. i__3 = *lwork - iwork + 1;
  1466. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  1467. , &i__3, &ierr);
  1468. /* Copy R to VT, zeroing out below it */
  1469. zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset],
  1470. ldvt);
  1471. if (*n > 1) {
  1472. i__3 = *n - 1;
  1473. i__2 = *n - 1;
  1474. zlaset_("L", &i__3, &i__2, &c_b1, &c_b1, &vt[vt_dim1
  1475. + 2], ldvt);
  1476. }
  1477. /* Generate Q in A */
  1478. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1479. /* (RWorkspace: 0) */
  1480. i__3 = *lwork - iwork + 1;
  1481. zungqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[
  1482. iwork], &i__3, &ierr);
  1483. ie = 1;
  1484. itauq = itau;
  1485. itaup = itauq + *n;
  1486. iwork = itaup + *n;
  1487. /* Bidiagonalize R in VT, copying result to WORK(IR) */
  1488. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) */
  1489. /* (RWorkspace: need N) */
  1490. i__3 = *lwork - iwork + 1;
  1491. zgebrd_(n, n, &vt[vt_offset], ldvt, &s[1], &rwork[ie], &
  1492. work[itauq], &work[itaup], &work[iwork], &i__3, &
  1493. ierr);
  1494. zlacpy_("L", n, n, &vt[vt_offset], ldvt, &work[ir], &
  1495. ldwrkr);
  1496. /* Generate left vectors bidiagonalizing R in WORK(IR) */
  1497. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) */
  1498. /* (RWorkspace: 0) */
  1499. i__3 = *lwork - iwork + 1;
  1500. zungbr_("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &
  1501. work[iwork], &i__3, &ierr);
  1502. /* Generate right vectors bidiagonalizing R in VT */
  1503. /* (CWorkspace: need N*N+3*N-1, prefer N*N+2*N+(N-1)*NB) */
  1504. /* (RWorkspace: 0) */
  1505. i__3 = *lwork - iwork + 1;
  1506. zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup],
  1507. &work[iwork], &i__3, &ierr);
  1508. irwork = ie + *n;
  1509. /* Perform bidiagonal QR iteration, computing left */
  1510. /* singular vectors of R in WORK(IR) and computing right */
  1511. /* singular vectors of R in VT */
  1512. /* (CWorkspace: need N*N) */
  1513. /* (RWorkspace: need BDSPAC) */
  1514. zbdsqr_("U", n, n, n, &c__0, &s[1], &rwork[ie], &vt[
  1515. vt_offset], ldvt, &work[ir], &ldwrkr, cdum, &c__1,
  1516. &rwork[irwork], info);
  1517. iu = itauq;
  1518. /* Multiply Q in A by left singular vectors of R in */
  1519. /* WORK(IR), storing result in WORK(IU) and copying to A */
  1520. /* (CWorkspace: need N*N+N, prefer N*N+M*N) */
  1521. /* (RWorkspace: 0) */
  1522. i__3 = *m;
  1523. i__2 = ldwrku;
  1524. for (i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ +=
  1525. i__2) {
  1526. /* Computing MIN */
  1527. i__4 = *m - i__ + 1;
  1528. chunk = f2cmin(i__4,ldwrku);
  1529. zgemm_("N", "N", &chunk, n, n, &c_b2, &a[i__ + a_dim1]
  1530. , lda, &work[ir], &ldwrkr, &c_b1, &work[iu], &
  1531. ldwrku);
  1532. zlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ +
  1533. a_dim1], lda);
  1534. /* L20: */
  1535. }
  1536. } else {
  1537. /* Insufficient workspace for a fast algorithm */
  1538. itau = 1;
  1539. iwork = itau + *n;
  1540. /* Compute A=Q*R */
  1541. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  1542. /* (RWorkspace: 0) */
  1543. i__2 = *lwork - iwork + 1;
  1544. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  1545. , &i__2, &ierr);
  1546. /* Copy R to VT, zeroing out below it */
  1547. zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset],
  1548. ldvt);
  1549. if (*n > 1) {
  1550. i__2 = *n - 1;
  1551. i__3 = *n - 1;
  1552. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &vt[vt_dim1
  1553. + 2], ldvt);
  1554. }
  1555. /* Generate Q in A */
  1556. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  1557. /* (RWorkspace: 0) */
  1558. i__2 = *lwork - iwork + 1;
  1559. zungqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[
  1560. iwork], &i__2, &ierr);
  1561. ie = 1;
  1562. itauq = itau;
  1563. itaup = itauq + *n;
  1564. iwork = itaup + *n;
  1565. /* Bidiagonalize R in VT */
  1566. /* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) */
  1567. /* (RWorkspace: N) */
  1568. i__2 = *lwork - iwork + 1;
  1569. zgebrd_(n, n, &vt[vt_offset], ldvt, &s[1], &rwork[ie], &
  1570. work[itauq], &work[itaup], &work[iwork], &i__2, &
  1571. ierr);
  1572. /* Multiply Q in A by left vectors bidiagonalizing R */
  1573. /* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) */
  1574. /* (RWorkspace: 0) */
  1575. i__2 = *lwork - iwork + 1;
  1576. zunmbr_("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, &
  1577. work[itauq], &a[a_offset], lda, &work[iwork], &
  1578. i__2, &ierr);
  1579. /* Generate right vectors bidiagonalizing R in VT */
  1580. /* (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) */
  1581. /* (RWorkspace: 0) */
  1582. i__2 = *lwork - iwork + 1;
  1583. zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup],
  1584. &work[iwork], &i__2, &ierr);
  1585. irwork = ie + *n;
  1586. /* Perform bidiagonal QR iteration, computing left */
  1587. /* singular vectors of A in A and computing right */
  1588. /* singular vectors of A in VT */
  1589. /* (CWorkspace: 0) */
  1590. /* (RWorkspace: need BDSPAC) */
  1591. zbdsqr_("U", n, n, m, &c__0, &s[1], &rwork[ie], &vt[
  1592. vt_offset], ldvt, &a[a_offset], lda, cdum, &c__1,
  1593. &rwork[irwork], info);
  1594. }
  1595. } else if (wntus) {
  1596. if (wntvn) {
  1597. /* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */
  1598. /* N left singular vectors to be computed in U and */
  1599. /* no right singular vectors to be computed */
  1600. if (*lwork >= *n * *n + *n * 3) {
  1601. /* Sufficient workspace for a fast algorithm */
  1602. ir = 1;
  1603. if (*lwork >= wrkbl + *lda * *n) {
  1604. /* WORK(IR) is LDA by N */
  1605. ldwrkr = *lda;
  1606. } else {
  1607. /* WORK(IR) is N by N */
  1608. ldwrkr = *n;
  1609. }
  1610. itau = ir + ldwrkr * *n;
  1611. iwork = itau + *n;
  1612. /* Compute A=Q*R */
  1613. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1614. /* (RWorkspace: 0) */
  1615. i__2 = *lwork - iwork + 1;
  1616. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1617. iwork], &i__2, &ierr);
  1618. /* Copy R to WORK(IR), zeroing out below it */
  1619. zlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &
  1620. ldwrkr);
  1621. i__2 = *n - 1;
  1622. i__3 = *n - 1;
  1623. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &work[ir + 1]
  1624. , &ldwrkr);
  1625. /* Generate Q in A */
  1626. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1627. /* (RWorkspace: 0) */
  1628. i__2 = *lwork - iwork + 1;
  1629. zungqr_(m, n, n, &a[a_offset], lda, &work[itau], &
  1630. work[iwork], &i__2, &ierr);
  1631. ie = 1;
  1632. itauq = itau;
  1633. itaup = itauq + *n;
  1634. iwork = itaup + *n;
  1635. /* Bidiagonalize R in WORK(IR) */
  1636. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) */
  1637. /* (RWorkspace: need N) */
  1638. i__2 = *lwork - iwork + 1;
  1639. zgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
  1640. work[itauq], &work[itaup], &work[iwork], &
  1641. i__2, &ierr);
  1642. /* Generate left vectors bidiagonalizing R in WORK(IR) */
  1643. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) */
  1644. /* (RWorkspace: 0) */
  1645. i__2 = *lwork - iwork + 1;
  1646. zungbr_("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq]
  1647. , &work[iwork], &i__2, &ierr);
  1648. irwork = ie + *n;
  1649. /* Perform bidiagonal QR iteration, computing left */
  1650. /* singular vectors of R in WORK(IR) */
  1651. /* (CWorkspace: need N*N) */
  1652. /* (RWorkspace: need BDSPAC) */
  1653. zbdsqr_("U", n, &c__0, n, &c__0, &s[1], &rwork[ie],
  1654. cdum, &c__1, &work[ir], &ldwrkr, cdum, &c__1,
  1655. &rwork[irwork], info);
  1656. /* Multiply Q in A by left singular vectors of R in */
  1657. /* WORK(IR), storing result in U */
  1658. /* (CWorkspace: need N*N) */
  1659. /* (RWorkspace: 0) */
  1660. zgemm_("N", "N", m, n, n, &c_b2, &a[a_offset], lda, &
  1661. work[ir], &ldwrkr, &c_b1, &u[u_offset], ldu);
  1662. } else {
  1663. /* Insufficient workspace for a fast algorithm */
  1664. itau = 1;
  1665. iwork = itau + *n;
  1666. /* Compute A=Q*R, copying result to U */
  1667. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  1668. /* (RWorkspace: 0) */
  1669. i__2 = *lwork - iwork + 1;
  1670. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1671. iwork], &i__2, &ierr);
  1672. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1673. ldu);
  1674. /* Generate Q in U */
  1675. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  1676. /* (RWorkspace: 0) */
  1677. i__2 = *lwork - iwork + 1;
  1678. zungqr_(m, n, n, &u[u_offset], ldu, &work[itau], &
  1679. work[iwork], &i__2, &ierr);
  1680. ie = 1;
  1681. itauq = itau;
  1682. itaup = itauq + *n;
  1683. iwork = itaup + *n;
  1684. /* Zero out below R in A */
  1685. if (*n > 1) {
  1686. i__2 = *n - 1;
  1687. i__3 = *n - 1;
  1688. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &a[
  1689. a_dim1 + 2], lda);
  1690. }
  1691. /* Bidiagonalize R in A */
  1692. /* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) */
  1693. /* (RWorkspace: need N) */
  1694. i__2 = *lwork - iwork + 1;
  1695. zgebrd_(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &
  1696. work[itauq], &work[itaup], &work[iwork], &
  1697. i__2, &ierr);
  1698. /* Multiply Q in U by left vectors bidiagonalizing R */
  1699. /* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) */
  1700. /* (RWorkspace: 0) */
  1701. i__2 = *lwork - iwork + 1;
  1702. zunmbr_("Q", "R", "N", m, n, n, &a[a_offset], lda, &
  1703. work[itauq], &u[u_offset], ldu, &work[iwork],
  1704. &i__2, &ierr)
  1705. ;
  1706. irwork = ie + *n;
  1707. /* Perform bidiagonal QR iteration, computing left */
  1708. /* singular vectors of A in U */
  1709. /* (CWorkspace: 0) */
  1710. /* (RWorkspace: need BDSPAC) */
  1711. zbdsqr_("U", n, &c__0, m, &c__0, &s[1], &rwork[ie],
  1712. cdum, &c__1, &u[u_offset], ldu, cdum, &c__1, &
  1713. rwork[irwork], info);
  1714. }
  1715. } else if (wntvo) {
  1716. /* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */
  1717. /* N left singular vectors to be computed in U and */
  1718. /* N right singular vectors to be overwritten on A */
  1719. if (*lwork >= (*n << 1) * *n + *n * 3) {
  1720. /* Sufficient workspace for a fast algorithm */
  1721. iu = 1;
  1722. if (*lwork >= wrkbl + (*lda << 1) * *n) {
  1723. /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */
  1724. ldwrku = *lda;
  1725. ir = iu + ldwrku * *n;
  1726. ldwrkr = *lda;
  1727. } else if (*lwork >= wrkbl + (*lda + *n) * *n) {
  1728. /* WORK(IU) is LDA by N and WORK(IR) is N by N */
  1729. ldwrku = *lda;
  1730. ir = iu + ldwrku * *n;
  1731. ldwrkr = *n;
  1732. } else {
  1733. /* WORK(IU) is N by N and WORK(IR) is N by N */
  1734. ldwrku = *n;
  1735. ir = iu + ldwrku * *n;
  1736. ldwrkr = *n;
  1737. }
  1738. itau = ir + ldwrkr * *n;
  1739. iwork = itau + *n;
  1740. /* Compute A=Q*R */
  1741. /* (CWorkspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */
  1742. /* (RWorkspace: 0) */
  1743. i__2 = *lwork - iwork + 1;
  1744. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1745. iwork], &i__2, &ierr);
  1746. /* Copy R to WORK(IU), zeroing out below it */
  1747. zlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &
  1748. ldwrku);
  1749. i__2 = *n - 1;
  1750. i__3 = *n - 1;
  1751. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &work[iu + 1]
  1752. , &ldwrku);
  1753. /* Generate Q in A */
  1754. /* (CWorkspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */
  1755. /* (RWorkspace: 0) */
  1756. i__2 = *lwork - iwork + 1;
  1757. zungqr_(m, n, n, &a[a_offset], lda, &work[itau], &
  1758. work[iwork], &i__2, &ierr);
  1759. ie = 1;
  1760. itauq = itau;
  1761. itaup = itauq + *n;
  1762. iwork = itaup + *n;
  1763. /* Bidiagonalize R in WORK(IU), copying result to */
  1764. /* WORK(IR) */
  1765. /* (CWorkspace: need 2*N*N+3*N, */
  1766. /* prefer 2*N*N+2*N+2*N*NB) */
  1767. /* (RWorkspace: need N) */
  1768. i__2 = *lwork - iwork + 1;
  1769. zgebrd_(n, n, &work[iu], &ldwrku, &s[1], &rwork[ie], &
  1770. work[itauq], &work[itaup], &work[iwork], &
  1771. i__2, &ierr);
  1772. zlacpy_("U", n, n, &work[iu], &ldwrku, &work[ir], &
  1773. ldwrkr);
  1774. /* Generate left bidiagonalizing vectors in WORK(IU) */
  1775. /* (CWorkspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB) */
  1776. /* (RWorkspace: 0) */
  1777. i__2 = *lwork - iwork + 1;
  1778. zungbr_("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
  1779. , &work[iwork], &i__2, &ierr);
  1780. /* Generate right bidiagonalizing vectors in WORK(IR) */
  1781. /* (CWorkspace: need 2*N*N+3*N-1, */
  1782. /* prefer 2*N*N+2*N+(N-1)*NB) */
  1783. /* (RWorkspace: 0) */
  1784. i__2 = *lwork - iwork + 1;
  1785. zungbr_("P", n, n, n, &work[ir], &ldwrkr, &work[itaup]
  1786. , &work[iwork], &i__2, &ierr);
  1787. irwork = ie + *n;
  1788. /* Perform bidiagonal QR iteration, computing left */
  1789. /* singular vectors of R in WORK(IU) and computing */
  1790. /* right singular vectors of R in WORK(IR) */
  1791. /* (CWorkspace: need 2*N*N) */
  1792. /* (RWorkspace: need BDSPAC) */
  1793. zbdsqr_("U", n, n, n, &c__0, &s[1], &rwork[ie], &work[
  1794. ir], &ldwrkr, &work[iu], &ldwrku, cdum, &c__1,
  1795. &rwork[irwork], info);
  1796. /* Multiply Q in A by left singular vectors of R in */
  1797. /* WORK(IU), storing result in U */
  1798. /* (CWorkspace: need N*N) */
  1799. /* (RWorkspace: 0) */
  1800. zgemm_("N", "N", m, n, n, &c_b2, &a[a_offset], lda, &
  1801. work[iu], &ldwrku, &c_b1, &u[u_offset], ldu);
  1802. /* Copy right singular vectors of R to A */
  1803. /* (CWorkspace: need N*N) */
  1804. /* (RWorkspace: 0) */
  1805. zlacpy_("F", n, n, &work[ir], &ldwrkr, &a[a_offset],
  1806. lda);
  1807. } else {
  1808. /* Insufficient workspace for a fast algorithm */
  1809. itau = 1;
  1810. iwork = itau + *n;
  1811. /* Compute A=Q*R, copying result to U */
  1812. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  1813. /* (RWorkspace: 0) */
  1814. i__2 = *lwork - iwork + 1;
  1815. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1816. iwork], &i__2, &ierr);
  1817. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1818. ldu);
  1819. /* Generate Q in U */
  1820. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  1821. /* (RWorkspace: 0) */
  1822. i__2 = *lwork - iwork + 1;
  1823. zungqr_(m, n, n, &u[u_offset], ldu, &work[itau], &
  1824. work[iwork], &i__2, &ierr);
  1825. ie = 1;
  1826. itauq = itau;
  1827. itaup = itauq + *n;
  1828. iwork = itaup + *n;
  1829. /* Zero out below R in A */
  1830. if (*n > 1) {
  1831. i__2 = *n - 1;
  1832. i__3 = *n - 1;
  1833. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &a[
  1834. a_dim1 + 2], lda);
  1835. }
  1836. /* Bidiagonalize R in A */
  1837. /* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) */
  1838. /* (RWorkspace: need N) */
  1839. i__2 = *lwork - iwork + 1;
  1840. zgebrd_(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &
  1841. work[itauq], &work[itaup], &work[iwork], &
  1842. i__2, &ierr);
  1843. /* Multiply Q in U by left vectors bidiagonalizing R */
  1844. /* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) */
  1845. /* (RWorkspace: 0) */
  1846. i__2 = *lwork - iwork + 1;
  1847. zunmbr_("Q", "R", "N", m, n, n, &a[a_offset], lda, &
  1848. work[itauq], &u[u_offset], ldu, &work[iwork],
  1849. &i__2, &ierr)
  1850. ;
  1851. /* Generate right vectors bidiagonalizing R in A */
  1852. /* (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) */
  1853. /* (RWorkspace: 0) */
  1854. i__2 = *lwork - iwork + 1;
  1855. zungbr_("P", n, n, n, &a[a_offset], lda, &work[itaup],
  1856. &work[iwork], &i__2, &ierr);
  1857. irwork = ie + *n;
  1858. /* Perform bidiagonal QR iteration, computing left */
  1859. /* singular vectors of A in U and computing right */
  1860. /* singular vectors of A in A */
  1861. /* (CWorkspace: 0) */
  1862. /* (RWorkspace: need BDSPAC) */
  1863. zbdsqr_("U", n, n, m, &c__0, &s[1], &rwork[ie], &a[
  1864. a_offset], lda, &u[u_offset], ldu, cdum, &
  1865. c__1, &rwork[irwork], info);
  1866. }
  1867. } else if (wntvas) {
  1868. /* Path 6 (M much larger than N, JOBU='S', JOBVT='S' */
  1869. /* or 'A') */
  1870. /* N left singular vectors to be computed in U and */
  1871. /* N right singular vectors to be computed in VT */
  1872. if (*lwork >= *n * *n + *n * 3) {
  1873. /* Sufficient workspace for a fast algorithm */
  1874. iu = 1;
  1875. if (*lwork >= wrkbl + *lda * *n) {
  1876. /* WORK(IU) is LDA by N */
  1877. ldwrku = *lda;
  1878. } else {
  1879. /* WORK(IU) is N by N */
  1880. ldwrku = *n;
  1881. }
  1882. itau = iu + ldwrku * *n;
  1883. iwork = itau + *n;
  1884. /* Compute A=Q*R */
  1885. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1886. /* (RWorkspace: 0) */
  1887. i__2 = *lwork - iwork + 1;
  1888. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1889. iwork], &i__2, &ierr);
  1890. /* Copy R to WORK(IU), zeroing out below it */
  1891. zlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &
  1892. ldwrku);
  1893. i__2 = *n - 1;
  1894. i__3 = *n - 1;
  1895. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &work[iu + 1]
  1896. , &ldwrku);
  1897. /* Generate Q in A */
  1898. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  1899. /* (RWorkspace: 0) */
  1900. i__2 = *lwork - iwork + 1;
  1901. zungqr_(m, n, n, &a[a_offset], lda, &work[itau], &
  1902. work[iwork], &i__2, &ierr);
  1903. ie = 1;
  1904. itauq = itau;
  1905. itaup = itauq + *n;
  1906. iwork = itaup + *n;
  1907. /* Bidiagonalize R in WORK(IU), copying result to VT */
  1908. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) */
  1909. /* (RWorkspace: need N) */
  1910. i__2 = *lwork - iwork + 1;
  1911. zgebrd_(n, n, &work[iu], &ldwrku, &s[1], &rwork[ie], &
  1912. work[itauq], &work[itaup], &work[iwork], &
  1913. i__2, &ierr);
  1914. zlacpy_("U", n, n, &work[iu], &ldwrku, &vt[vt_offset],
  1915. ldvt);
  1916. /* Generate left bidiagonalizing vectors in WORK(IU) */
  1917. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) */
  1918. /* (RWorkspace: 0) */
  1919. i__2 = *lwork - iwork + 1;
  1920. zungbr_("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
  1921. , &work[iwork], &i__2, &ierr);
  1922. /* Generate right bidiagonalizing vectors in VT */
  1923. /* (CWorkspace: need N*N+3*N-1, */
  1924. /* prefer N*N+2*N+(N-1)*NB) */
  1925. /* (RWorkspace: 0) */
  1926. i__2 = *lwork - iwork + 1;
  1927. zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[
  1928. itaup], &work[iwork], &i__2, &ierr)
  1929. ;
  1930. irwork = ie + *n;
  1931. /* Perform bidiagonal QR iteration, computing left */
  1932. /* singular vectors of R in WORK(IU) and computing */
  1933. /* right singular vectors of R in VT */
  1934. /* (CWorkspace: need N*N) */
  1935. /* (RWorkspace: need BDSPAC) */
  1936. zbdsqr_("U", n, n, n, &c__0, &s[1], &rwork[ie], &vt[
  1937. vt_offset], ldvt, &work[iu], &ldwrku, cdum, &
  1938. c__1, &rwork[irwork], info);
  1939. /* Multiply Q in A by left singular vectors of R in */
  1940. /* WORK(IU), storing result in U */
  1941. /* (CWorkspace: need N*N) */
  1942. /* (RWorkspace: 0) */
  1943. zgemm_("N", "N", m, n, n, &c_b2, &a[a_offset], lda, &
  1944. work[iu], &ldwrku, &c_b1, &u[u_offset], ldu);
  1945. } else {
  1946. /* Insufficient workspace for a fast algorithm */
  1947. itau = 1;
  1948. iwork = itau + *n;
  1949. /* Compute A=Q*R, copying result to U */
  1950. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  1951. /* (RWorkspace: 0) */
  1952. i__2 = *lwork - iwork + 1;
  1953. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  1954. iwork], &i__2, &ierr);
  1955. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  1956. ldu);
  1957. /* Generate Q in U */
  1958. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  1959. /* (RWorkspace: 0) */
  1960. i__2 = *lwork - iwork + 1;
  1961. zungqr_(m, n, n, &u[u_offset], ldu, &work[itau], &
  1962. work[iwork], &i__2, &ierr);
  1963. /* Copy R to VT, zeroing out below it */
  1964. zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset],
  1965. ldvt);
  1966. if (*n > 1) {
  1967. i__2 = *n - 1;
  1968. i__3 = *n - 1;
  1969. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &vt[
  1970. vt_dim1 + 2], ldvt);
  1971. }
  1972. ie = 1;
  1973. itauq = itau;
  1974. itaup = itauq + *n;
  1975. iwork = itaup + *n;
  1976. /* Bidiagonalize R in VT */
  1977. /* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) */
  1978. /* (RWorkspace: need N) */
  1979. i__2 = *lwork - iwork + 1;
  1980. zgebrd_(n, n, &vt[vt_offset], ldvt, &s[1], &rwork[ie],
  1981. &work[itauq], &work[itaup], &work[iwork], &
  1982. i__2, &ierr);
  1983. /* Multiply Q in U by left bidiagonalizing vectors */
  1984. /* in VT */
  1985. /* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) */
  1986. /* (RWorkspace: 0) */
  1987. i__2 = *lwork - iwork + 1;
  1988. zunmbr_("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt,
  1989. &work[itauq], &u[u_offset], ldu, &work[iwork],
  1990. &i__2, &ierr);
  1991. /* Generate right bidiagonalizing vectors in VT */
  1992. /* (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) */
  1993. /* (RWorkspace: 0) */
  1994. i__2 = *lwork - iwork + 1;
  1995. zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[
  1996. itaup], &work[iwork], &i__2, &ierr)
  1997. ;
  1998. irwork = ie + *n;
  1999. /* Perform bidiagonal QR iteration, computing left */
  2000. /* singular vectors of A in U and computing right */
  2001. /* singular vectors of A in VT */
  2002. /* (CWorkspace: 0) */
  2003. /* (RWorkspace: need BDSPAC) */
  2004. zbdsqr_("U", n, n, m, &c__0, &s[1], &rwork[ie], &vt[
  2005. vt_offset], ldvt, &u[u_offset], ldu, cdum, &
  2006. c__1, &rwork[irwork], info);
  2007. }
  2008. }
  2009. } else if (wntua) {
  2010. if (wntvn) {
  2011. /* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */
  2012. /* M left singular vectors to be computed in U and */
  2013. /* no right singular vectors to be computed */
  2014. /* Computing MAX */
  2015. i__2 = *n + *m, i__3 = *n * 3;
  2016. if (*lwork >= *n * *n + f2cmax(i__2,i__3)) {
  2017. /* Sufficient workspace for a fast algorithm */
  2018. ir = 1;
  2019. if (*lwork >= wrkbl + *lda * *n) {
  2020. /* WORK(IR) is LDA by N */
  2021. ldwrkr = *lda;
  2022. } else {
  2023. /* WORK(IR) is N by N */
  2024. ldwrkr = *n;
  2025. }
  2026. itau = ir + ldwrkr * *n;
  2027. iwork = itau + *n;
  2028. /* Compute A=Q*R, copying result to U */
  2029. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  2030. /* (RWorkspace: 0) */
  2031. i__2 = *lwork - iwork + 1;
  2032. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2033. iwork], &i__2, &ierr);
  2034. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  2035. ldu);
  2036. /* Copy R to WORK(IR), zeroing out below it */
  2037. zlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &
  2038. ldwrkr);
  2039. i__2 = *n - 1;
  2040. i__3 = *n - 1;
  2041. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &work[ir + 1]
  2042. , &ldwrkr);
  2043. /* Generate Q in U */
  2044. /* (CWorkspace: need N*N+N+M, prefer N*N+N+M*NB) */
  2045. /* (RWorkspace: 0) */
  2046. i__2 = *lwork - iwork + 1;
  2047. zungqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  2048. work[iwork], &i__2, &ierr);
  2049. ie = 1;
  2050. itauq = itau;
  2051. itaup = itauq + *n;
  2052. iwork = itaup + *n;
  2053. /* Bidiagonalize R in WORK(IR) */
  2054. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) */
  2055. /* (RWorkspace: need N) */
  2056. i__2 = *lwork - iwork + 1;
  2057. zgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
  2058. work[itauq], &work[itaup], &work[iwork], &
  2059. i__2, &ierr);
  2060. /* Generate left bidiagonalizing vectors in WORK(IR) */
  2061. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) */
  2062. /* (RWorkspace: 0) */
  2063. i__2 = *lwork - iwork + 1;
  2064. zungbr_("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq]
  2065. , &work[iwork], &i__2, &ierr);
  2066. irwork = ie + *n;
  2067. /* Perform bidiagonal QR iteration, computing left */
  2068. /* singular vectors of R in WORK(IR) */
  2069. /* (CWorkspace: need N*N) */
  2070. /* (RWorkspace: need BDSPAC) */
  2071. zbdsqr_("U", n, &c__0, n, &c__0, &s[1], &rwork[ie],
  2072. cdum, &c__1, &work[ir], &ldwrkr, cdum, &c__1,
  2073. &rwork[irwork], info);
  2074. /* Multiply Q in U by left singular vectors of R in */
  2075. /* WORK(IR), storing result in A */
  2076. /* (CWorkspace: need N*N) */
  2077. /* (RWorkspace: 0) */
  2078. zgemm_("N", "N", m, n, n, &c_b2, &u[u_offset], ldu, &
  2079. work[ir], &ldwrkr, &c_b1, &a[a_offset], lda);
  2080. /* Copy left singular vectors of A from A to U */
  2081. zlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset],
  2082. ldu);
  2083. } else {
  2084. /* Insufficient workspace for a fast algorithm */
  2085. itau = 1;
  2086. iwork = itau + *n;
  2087. /* Compute A=Q*R, copying result to U */
  2088. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  2089. /* (RWorkspace: 0) */
  2090. i__2 = *lwork - iwork + 1;
  2091. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2092. iwork], &i__2, &ierr);
  2093. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  2094. ldu);
  2095. /* Generate Q in U */
  2096. /* (CWorkspace: need N+M, prefer N+M*NB) */
  2097. /* (RWorkspace: 0) */
  2098. i__2 = *lwork - iwork + 1;
  2099. zungqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  2100. work[iwork], &i__2, &ierr);
  2101. ie = 1;
  2102. itauq = itau;
  2103. itaup = itauq + *n;
  2104. iwork = itaup + *n;
  2105. /* Zero out below R in A */
  2106. if (*n > 1) {
  2107. i__2 = *n - 1;
  2108. i__3 = *n - 1;
  2109. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &a[
  2110. a_dim1 + 2], lda);
  2111. }
  2112. /* Bidiagonalize R in A */
  2113. /* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) */
  2114. /* (RWorkspace: need N) */
  2115. i__2 = *lwork - iwork + 1;
  2116. zgebrd_(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &
  2117. work[itauq], &work[itaup], &work[iwork], &
  2118. i__2, &ierr);
  2119. /* Multiply Q in U by left bidiagonalizing vectors */
  2120. /* in A */
  2121. /* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) */
  2122. /* (RWorkspace: 0) */
  2123. i__2 = *lwork - iwork + 1;
  2124. zunmbr_("Q", "R", "N", m, n, n, &a[a_offset], lda, &
  2125. work[itauq], &u[u_offset], ldu, &work[iwork],
  2126. &i__2, &ierr)
  2127. ;
  2128. irwork = ie + *n;
  2129. /* Perform bidiagonal QR iteration, computing left */
  2130. /* singular vectors of A in U */
  2131. /* (CWorkspace: 0) */
  2132. /* (RWorkspace: need BDSPAC) */
  2133. zbdsqr_("U", n, &c__0, m, &c__0, &s[1], &rwork[ie],
  2134. cdum, &c__1, &u[u_offset], ldu, cdum, &c__1, &
  2135. rwork[irwork], info);
  2136. }
  2137. } else if (wntvo) {
  2138. /* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */
  2139. /* M left singular vectors to be computed in U and */
  2140. /* N right singular vectors to be overwritten on A */
  2141. /* Computing MAX */
  2142. i__2 = *n + *m, i__3 = *n * 3;
  2143. if (*lwork >= (*n << 1) * *n + f2cmax(i__2,i__3)) {
  2144. /* Sufficient workspace for a fast algorithm */
  2145. iu = 1;
  2146. if (*lwork >= wrkbl + (*lda << 1) * *n) {
  2147. /* WORK(IU) is LDA by N and WORK(IR) is LDA by N */
  2148. ldwrku = *lda;
  2149. ir = iu + ldwrku * *n;
  2150. ldwrkr = *lda;
  2151. } else if (*lwork >= wrkbl + (*lda + *n) * *n) {
  2152. /* WORK(IU) is LDA by N and WORK(IR) is N by N */
  2153. ldwrku = *lda;
  2154. ir = iu + ldwrku * *n;
  2155. ldwrkr = *n;
  2156. } else {
  2157. /* WORK(IU) is N by N and WORK(IR) is N by N */
  2158. ldwrku = *n;
  2159. ir = iu + ldwrku * *n;
  2160. ldwrkr = *n;
  2161. }
  2162. itau = ir + ldwrkr * *n;
  2163. iwork = itau + *n;
  2164. /* Compute A=Q*R, copying result to U */
  2165. /* (CWorkspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */
  2166. /* (RWorkspace: 0) */
  2167. i__2 = *lwork - iwork + 1;
  2168. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2169. iwork], &i__2, &ierr);
  2170. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  2171. ldu);
  2172. /* Generate Q in U */
  2173. /* (CWorkspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB) */
  2174. /* (RWorkspace: 0) */
  2175. i__2 = *lwork - iwork + 1;
  2176. zungqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  2177. work[iwork], &i__2, &ierr);
  2178. /* Copy R to WORK(IU), zeroing out below it */
  2179. zlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &
  2180. ldwrku);
  2181. i__2 = *n - 1;
  2182. i__3 = *n - 1;
  2183. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &work[iu + 1]
  2184. , &ldwrku);
  2185. ie = 1;
  2186. itauq = itau;
  2187. itaup = itauq + *n;
  2188. iwork = itaup + *n;
  2189. /* Bidiagonalize R in WORK(IU), copying result to */
  2190. /* WORK(IR) */
  2191. /* (CWorkspace: need 2*N*N+3*N, */
  2192. /* prefer 2*N*N+2*N+2*N*NB) */
  2193. /* (RWorkspace: need N) */
  2194. i__2 = *lwork - iwork + 1;
  2195. zgebrd_(n, n, &work[iu], &ldwrku, &s[1], &rwork[ie], &
  2196. work[itauq], &work[itaup], &work[iwork], &
  2197. i__2, &ierr);
  2198. zlacpy_("U", n, n, &work[iu], &ldwrku, &work[ir], &
  2199. ldwrkr);
  2200. /* Generate left bidiagonalizing vectors in WORK(IU) */
  2201. /* (CWorkspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB) */
  2202. /* (RWorkspace: 0) */
  2203. i__2 = *lwork - iwork + 1;
  2204. zungbr_("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
  2205. , &work[iwork], &i__2, &ierr);
  2206. /* Generate right bidiagonalizing vectors in WORK(IR) */
  2207. /* (CWorkspace: need 2*N*N+3*N-1, */
  2208. /* prefer 2*N*N+2*N+(N-1)*NB) */
  2209. /* (RWorkspace: 0) */
  2210. i__2 = *lwork - iwork + 1;
  2211. zungbr_("P", n, n, n, &work[ir], &ldwrkr, &work[itaup]
  2212. , &work[iwork], &i__2, &ierr);
  2213. irwork = ie + *n;
  2214. /* Perform bidiagonal QR iteration, computing left */
  2215. /* singular vectors of R in WORK(IU) and computing */
  2216. /* right singular vectors of R in WORK(IR) */
  2217. /* (CWorkspace: need 2*N*N) */
  2218. /* (RWorkspace: need BDSPAC) */
  2219. zbdsqr_("U", n, n, n, &c__0, &s[1], &rwork[ie], &work[
  2220. ir], &ldwrkr, &work[iu], &ldwrku, cdum, &c__1,
  2221. &rwork[irwork], info);
  2222. /* Multiply Q in U by left singular vectors of R in */
  2223. /* WORK(IU), storing result in A */
  2224. /* (CWorkspace: need N*N) */
  2225. /* (RWorkspace: 0) */
  2226. zgemm_("N", "N", m, n, n, &c_b2, &u[u_offset], ldu, &
  2227. work[iu], &ldwrku, &c_b1, &a[a_offset], lda);
  2228. /* Copy left singular vectors of A from A to U */
  2229. zlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset],
  2230. ldu);
  2231. /* Copy right singular vectors of R from WORK(IR) to A */
  2232. zlacpy_("F", n, n, &work[ir], &ldwrkr, &a[a_offset],
  2233. lda);
  2234. } else {
  2235. /* Insufficient workspace for a fast algorithm */
  2236. itau = 1;
  2237. iwork = itau + *n;
  2238. /* Compute A=Q*R, copying result to U */
  2239. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  2240. /* (RWorkspace: 0) */
  2241. i__2 = *lwork - iwork + 1;
  2242. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2243. iwork], &i__2, &ierr);
  2244. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  2245. ldu);
  2246. /* Generate Q in U */
  2247. /* (CWorkspace: need N+M, prefer N+M*NB) */
  2248. /* (RWorkspace: 0) */
  2249. i__2 = *lwork - iwork + 1;
  2250. zungqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  2251. work[iwork], &i__2, &ierr);
  2252. ie = 1;
  2253. itauq = itau;
  2254. itaup = itauq + *n;
  2255. iwork = itaup + *n;
  2256. /* Zero out below R in A */
  2257. if (*n > 1) {
  2258. i__2 = *n - 1;
  2259. i__3 = *n - 1;
  2260. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &a[
  2261. a_dim1 + 2], lda);
  2262. }
  2263. /* Bidiagonalize R in A */
  2264. /* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) */
  2265. /* (RWorkspace: need N) */
  2266. i__2 = *lwork - iwork + 1;
  2267. zgebrd_(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &
  2268. work[itauq], &work[itaup], &work[iwork], &
  2269. i__2, &ierr);
  2270. /* Multiply Q in U by left bidiagonalizing vectors */
  2271. /* in A */
  2272. /* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) */
  2273. /* (RWorkspace: 0) */
  2274. i__2 = *lwork - iwork + 1;
  2275. zunmbr_("Q", "R", "N", m, n, n, &a[a_offset], lda, &
  2276. work[itauq], &u[u_offset], ldu, &work[iwork],
  2277. &i__2, &ierr)
  2278. ;
  2279. /* Generate right bidiagonalizing vectors in A */
  2280. /* (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) */
  2281. /* (RWorkspace: 0) */
  2282. i__2 = *lwork - iwork + 1;
  2283. zungbr_("P", n, n, n, &a[a_offset], lda, &work[itaup],
  2284. &work[iwork], &i__2, &ierr);
  2285. irwork = ie + *n;
  2286. /* Perform bidiagonal QR iteration, computing left */
  2287. /* singular vectors of A in U and computing right */
  2288. /* singular vectors of A in A */
  2289. /* (CWorkspace: 0) */
  2290. /* (RWorkspace: need BDSPAC) */
  2291. zbdsqr_("U", n, n, m, &c__0, &s[1], &rwork[ie], &a[
  2292. a_offset], lda, &u[u_offset], ldu, cdum, &
  2293. c__1, &rwork[irwork], info);
  2294. }
  2295. } else if (wntvas) {
  2296. /* Path 9 (M much larger than N, JOBU='A', JOBVT='S' */
  2297. /* or 'A') */
  2298. /* M left singular vectors to be computed in U and */
  2299. /* N right singular vectors to be computed in VT */
  2300. /* Computing MAX */
  2301. i__2 = *n + *m, i__3 = *n * 3;
  2302. if (*lwork >= *n * *n + f2cmax(i__2,i__3)) {
  2303. /* Sufficient workspace for a fast algorithm */
  2304. iu = 1;
  2305. if (*lwork >= wrkbl + *lda * *n) {
  2306. /* WORK(IU) is LDA by N */
  2307. ldwrku = *lda;
  2308. } else {
  2309. /* WORK(IU) is N by N */
  2310. ldwrku = *n;
  2311. }
  2312. itau = iu + ldwrku * *n;
  2313. iwork = itau + *n;
  2314. /* Compute A=Q*R, copying result to U */
  2315. /* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) */
  2316. /* (RWorkspace: 0) */
  2317. i__2 = *lwork - iwork + 1;
  2318. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2319. iwork], &i__2, &ierr);
  2320. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  2321. ldu);
  2322. /* Generate Q in U */
  2323. /* (CWorkspace: need N*N+N+M, prefer N*N+N+M*NB) */
  2324. /* (RWorkspace: 0) */
  2325. i__2 = *lwork - iwork + 1;
  2326. zungqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  2327. work[iwork], &i__2, &ierr);
  2328. /* Copy R to WORK(IU), zeroing out below it */
  2329. zlacpy_("U", n, n, &a[a_offset], lda, &work[iu], &
  2330. ldwrku);
  2331. i__2 = *n - 1;
  2332. i__3 = *n - 1;
  2333. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &work[iu + 1]
  2334. , &ldwrku);
  2335. ie = 1;
  2336. itauq = itau;
  2337. itaup = itauq + *n;
  2338. iwork = itaup + *n;
  2339. /* Bidiagonalize R in WORK(IU), copying result to VT */
  2340. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) */
  2341. /* (RWorkspace: need N) */
  2342. i__2 = *lwork - iwork + 1;
  2343. zgebrd_(n, n, &work[iu], &ldwrku, &s[1], &rwork[ie], &
  2344. work[itauq], &work[itaup], &work[iwork], &
  2345. i__2, &ierr);
  2346. zlacpy_("U", n, n, &work[iu], &ldwrku, &vt[vt_offset],
  2347. ldvt);
  2348. /* Generate left bidiagonalizing vectors in WORK(IU) */
  2349. /* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) */
  2350. /* (RWorkspace: 0) */
  2351. i__2 = *lwork - iwork + 1;
  2352. zungbr_("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
  2353. , &work[iwork], &i__2, &ierr);
  2354. /* Generate right bidiagonalizing vectors in VT */
  2355. /* (CWorkspace: need N*N+3*N-1, */
  2356. /* prefer N*N+2*N+(N-1)*NB) */
  2357. /* (RWorkspace: need 0) */
  2358. i__2 = *lwork - iwork + 1;
  2359. zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[
  2360. itaup], &work[iwork], &i__2, &ierr)
  2361. ;
  2362. irwork = ie + *n;
  2363. /* Perform bidiagonal QR iteration, computing left */
  2364. /* singular vectors of R in WORK(IU) and computing */
  2365. /* right singular vectors of R in VT */
  2366. /* (CWorkspace: need N*N) */
  2367. /* (RWorkspace: need BDSPAC) */
  2368. zbdsqr_("U", n, n, n, &c__0, &s[1], &rwork[ie], &vt[
  2369. vt_offset], ldvt, &work[iu], &ldwrku, cdum, &
  2370. c__1, &rwork[irwork], info);
  2371. /* Multiply Q in U by left singular vectors of R in */
  2372. /* WORK(IU), storing result in A */
  2373. /* (CWorkspace: need N*N) */
  2374. /* (RWorkspace: 0) */
  2375. zgemm_("N", "N", m, n, n, &c_b2, &u[u_offset], ldu, &
  2376. work[iu], &ldwrku, &c_b1, &a[a_offset], lda);
  2377. /* Copy left singular vectors of A from A to U */
  2378. zlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset],
  2379. ldu);
  2380. } else {
  2381. /* Insufficient workspace for a fast algorithm */
  2382. itau = 1;
  2383. iwork = itau + *n;
  2384. /* Compute A=Q*R, copying result to U */
  2385. /* (CWorkspace: need 2*N, prefer N+N*NB) */
  2386. /* (RWorkspace: 0) */
  2387. i__2 = *lwork - iwork + 1;
  2388. zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2389. iwork], &i__2, &ierr);
  2390. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset],
  2391. ldu);
  2392. /* Generate Q in U */
  2393. /* (CWorkspace: need N+M, prefer N+M*NB) */
  2394. /* (RWorkspace: 0) */
  2395. i__2 = *lwork - iwork + 1;
  2396. zungqr_(m, m, n, &u[u_offset], ldu, &work[itau], &
  2397. work[iwork], &i__2, &ierr);
  2398. /* Copy R from A to VT, zeroing out below it */
  2399. zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset],
  2400. ldvt);
  2401. if (*n > 1) {
  2402. i__2 = *n - 1;
  2403. i__3 = *n - 1;
  2404. zlaset_("L", &i__2, &i__3, &c_b1, &c_b1, &vt[
  2405. vt_dim1 + 2], ldvt);
  2406. }
  2407. ie = 1;
  2408. itauq = itau;
  2409. itaup = itauq + *n;
  2410. iwork = itaup + *n;
  2411. /* Bidiagonalize R in VT */
  2412. /* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) */
  2413. /* (RWorkspace: need N) */
  2414. i__2 = *lwork - iwork + 1;
  2415. zgebrd_(n, n, &vt[vt_offset], ldvt, &s[1], &rwork[ie],
  2416. &work[itauq], &work[itaup], &work[iwork], &
  2417. i__2, &ierr);
  2418. /* Multiply Q in U by left bidiagonalizing vectors */
  2419. /* in VT */
  2420. /* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) */
  2421. /* (RWorkspace: 0) */
  2422. i__2 = *lwork - iwork + 1;
  2423. zunmbr_("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt,
  2424. &work[itauq], &u[u_offset], ldu, &work[iwork],
  2425. &i__2, &ierr);
  2426. /* Generate right bidiagonalizing vectors in VT */
  2427. /* (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) */
  2428. /* (RWorkspace: 0) */
  2429. i__2 = *lwork - iwork + 1;
  2430. zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[
  2431. itaup], &work[iwork], &i__2, &ierr)
  2432. ;
  2433. irwork = ie + *n;
  2434. /* Perform bidiagonal QR iteration, computing left */
  2435. /* singular vectors of A in U and computing right */
  2436. /* singular vectors of A in VT */
  2437. /* (CWorkspace: 0) */
  2438. /* (RWorkspace: need BDSPAC) */
  2439. zbdsqr_("U", n, n, m, &c__0, &s[1], &rwork[ie], &vt[
  2440. vt_offset], ldvt, &u[u_offset], ldu, cdum, &
  2441. c__1, &rwork[irwork], info);
  2442. }
  2443. }
  2444. }
  2445. } else {
  2446. /* M .LT. MNTHR */
  2447. /* Path 10 (M at least N, but not much larger) */
  2448. /* Reduce to bidiagonal form without QR decomposition */
  2449. ie = 1;
  2450. itauq = 1;
  2451. itaup = itauq + *n;
  2452. iwork = itaup + *n;
  2453. /* Bidiagonalize A */
  2454. /* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) */
  2455. /* (RWorkspace: need N) */
  2456. i__2 = *lwork - iwork + 1;
  2457. zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
  2458. &work[itaup], &work[iwork], &i__2, &ierr);
  2459. if (wntuas) {
  2460. /* If left singular vectors desired in U, copy result to U */
  2461. /* and generate left bidiagonalizing vectors in U */
  2462. /* (CWorkspace: need 2*N+NCU, prefer 2*N+NCU*NB) */
  2463. /* (RWorkspace: 0) */
  2464. zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
  2465. if (wntus) {
  2466. ncu = *n;
  2467. }
  2468. if (wntua) {
  2469. ncu = *m;
  2470. }
  2471. i__2 = *lwork - iwork + 1;
  2472. zungbr_("Q", m, &ncu, n, &u[u_offset], ldu, &work[itauq], &
  2473. work[iwork], &i__2, &ierr);
  2474. }
  2475. if (wntvas) {
  2476. /* If right singular vectors desired in VT, copy result to */
  2477. /* VT and generate right bidiagonalizing vectors in VT */
  2478. /* (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) */
  2479. /* (RWorkspace: 0) */
  2480. zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
  2481. i__2 = *lwork - iwork + 1;
  2482. zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &
  2483. work[iwork], &i__2, &ierr);
  2484. }
  2485. if (wntuo) {
  2486. /* If left singular vectors desired in A, generate left */
  2487. /* bidiagonalizing vectors in A */
  2488. /* (CWorkspace: need 3*N, prefer 2*N+N*NB) */
  2489. /* (RWorkspace: 0) */
  2490. i__2 = *lwork - iwork + 1;
  2491. zungbr_("Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[
  2492. iwork], &i__2, &ierr);
  2493. }
  2494. if (wntvo) {
  2495. /* If right singular vectors desired in A, generate right */
  2496. /* bidiagonalizing vectors in A */
  2497. /* (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) */
  2498. /* (RWorkspace: 0) */
  2499. i__2 = *lwork - iwork + 1;
  2500. zungbr_("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[
  2501. iwork], &i__2, &ierr);
  2502. }
  2503. irwork = ie + *n;
  2504. if (wntuas || wntuo) {
  2505. nru = *m;
  2506. }
  2507. if (wntun) {
  2508. nru = 0;
  2509. }
  2510. if (wntvas || wntvo) {
  2511. ncvt = *n;
  2512. }
  2513. if (wntvn) {
  2514. ncvt = 0;
  2515. }
  2516. if (! wntuo && ! wntvo) {
  2517. /* Perform bidiagonal QR iteration, if desired, computing */
  2518. /* left singular vectors in U and computing right singular */
  2519. /* vectors in VT */
  2520. /* (CWorkspace: 0) */
  2521. /* (RWorkspace: need BDSPAC) */
  2522. zbdsqr_("U", n, &ncvt, &nru, &c__0, &s[1], &rwork[ie], &vt[
  2523. vt_offset], ldvt, &u[u_offset], ldu, cdum, &c__1, &
  2524. rwork[irwork], info);
  2525. } else if (! wntuo && wntvo) {
  2526. /* Perform bidiagonal QR iteration, if desired, computing */
  2527. /* left singular vectors in U and computing right singular */
  2528. /* vectors in A */
  2529. /* (CWorkspace: 0) */
  2530. /* (RWorkspace: need BDSPAC) */
  2531. zbdsqr_("U", n, &ncvt, &nru, &c__0, &s[1], &rwork[ie], &a[
  2532. a_offset], lda, &u[u_offset], ldu, cdum, &c__1, &
  2533. rwork[irwork], info);
  2534. } else {
  2535. /* Perform bidiagonal QR iteration, if desired, computing */
  2536. /* left singular vectors in A and computing right singular */
  2537. /* vectors in VT */
  2538. /* (CWorkspace: 0) */
  2539. /* (RWorkspace: need BDSPAC) */
  2540. zbdsqr_("U", n, &ncvt, &nru, &c__0, &s[1], &rwork[ie], &vt[
  2541. vt_offset], ldvt, &a[a_offset], lda, cdum, &c__1, &
  2542. rwork[irwork], info);
  2543. }
  2544. }
  2545. } else {
  2546. /* A has more columns than rows. If A has sufficiently more */
  2547. /* columns than rows, first reduce using the LQ decomposition (if */
  2548. /* sufficient workspace available) */
  2549. if (*n >= mnthr) {
  2550. if (wntvn) {
  2551. /* Path 1t(N much larger than M, JOBVT='N') */
  2552. /* No right singular vectors to be computed */
  2553. itau = 1;
  2554. iwork = itau + *m;
  2555. /* Compute A=L*Q */
  2556. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  2557. /* (RWorkspace: 0) */
  2558. i__2 = *lwork - iwork + 1;
  2559. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &
  2560. i__2, &ierr);
  2561. /* Zero out above L */
  2562. i__2 = *m - 1;
  2563. i__3 = *m - 1;
  2564. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 << 1) + 1]
  2565. , lda);
  2566. ie = 1;
  2567. itauq = 1;
  2568. itaup = itauq + *m;
  2569. iwork = itaup + *m;
  2570. /* Bidiagonalize L in A */
  2571. /* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) */
  2572. /* (RWorkspace: need M) */
  2573. i__2 = *lwork - iwork + 1;
  2574. zgebrd_(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &work[
  2575. itauq], &work[itaup], &work[iwork], &i__2, &ierr);
  2576. if (wntuo || wntuas) {
  2577. /* If left singular vectors desired, generate Q */
  2578. /* (CWorkspace: need 3*M, prefer 2*M+M*NB) */
  2579. /* (RWorkspace: 0) */
  2580. i__2 = *lwork - iwork + 1;
  2581. zungbr_("Q", m, m, m, &a[a_offset], lda, &work[itauq], &
  2582. work[iwork], &i__2, &ierr);
  2583. }
  2584. irwork = ie + *m;
  2585. nru = 0;
  2586. if (wntuo || wntuas) {
  2587. nru = *m;
  2588. }
  2589. /* Perform bidiagonal QR iteration, computing left singular */
  2590. /* vectors of A in A if desired */
  2591. /* (CWorkspace: 0) */
  2592. /* (RWorkspace: need BDSPAC) */
  2593. zbdsqr_("U", m, &c__0, &nru, &c__0, &s[1], &rwork[ie], cdum, &
  2594. c__1, &a[a_offset], lda, cdum, &c__1, &rwork[irwork],
  2595. info);
  2596. /* If left singular vectors desired in U, copy them there */
  2597. if (wntuas) {
  2598. zlacpy_("F", m, m, &a[a_offset], lda, &u[u_offset], ldu);
  2599. }
  2600. } else if (wntvo && wntun) {
  2601. /* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */
  2602. /* M right singular vectors to be overwritten on A and */
  2603. /* no left singular vectors to be computed */
  2604. if (*lwork >= *m * *m + *m * 3) {
  2605. /* Sufficient workspace for a fast algorithm */
  2606. ir = 1;
  2607. /* Computing MAX */
  2608. i__2 = wrkbl, i__3 = *lda * *n;
  2609. if (*lwork >= f2cmax(i__2,i__3) + *lda * *m) {
  2610. /* WORK(IU) is LDA by N and WORK(IR) is LDA by M */
  2611. ldwrku = *lda;
  2612. chunk = *n;
  2613. ldwrkr = *lda;
  2614. } else /* if(complicated condition) */ {
  2615. /* Computing MAX */
  2616. i__2 = wrkbl, i__3 = *lda * *n;
  2617. if (*lwork >= f2cmax(i__2,i__3) + *m * *m) {
  2618. /* WORK(IU) is LDA by N and WORK(IR) is M by M */
  2619. ldwrku = *lda;
  2620. chunk = *n;
  2621. ldwrkr = *m;
  2622. } else {
  2623. /* WORK(IU) is M by CHUNK and WORK(IR) is M by M */
  2624. ldwrku = *m;
  2625. chunk = (*lwork - *m * *m) / *m;
  2626. ldwrkr = *m;
  2627. }
  2628. }
  2629. itau = ir + ldwrkr * *m;
  2630. iwork = itau + *m;
  2631. /* Compute A=L*Q */
  2632. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2633. /* (RWorkspace: 0) */
  2634. i__2 = *lwork - iwork + 1;
  2635. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  2636. , &i__2, &ierr);
  2637. /* Copy L to WORK(IR) and zero out above it */
  2638. zlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr);
  2639. i__2 = *m - 1;
  2640. i__3 = *m - 1;
  2641. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &work[ir +
  2642. ldwrkr], &ldwrkr);
  2643. /* Generate Q in A */
  2644. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2645. /* (RWorkspace: 0) */
  2646. i__2 = *lwork - iwork + 1;
  2647. zunglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[
  2648. iwork], &i__2, &ierr);
  2649. ie = 1;
  2650. itauq = itau;
  2651. itaup = itauq + *m;
  2652. iwork = itaup + *m;
  2653. /* Bidiagonalize L in WORK(IR) */
  2654. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) */
  2655. /* (RWorkspace: need M) */
  2656. i__2 = *lwork - iwork + 1;
  2657. zgebrd_(m, m, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
  2658. work[itauq], &work[itaup], &work[iwork], &i__2, &
  2659. ierr);
  2660. /* Generate right vectors bidiagonalizing L */
  2661. /* (CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB) */
  2662. /* (RWorkspace: 0) */
  2663. i__2 = *lwork - iwork + 1;
  2664. zungbr_("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &
  2665. work[iwork], &i__2, &ierr);
  2666. irwork = ie + *m;
  2667. /* Perform bidiagonal QR iteration, computing right */
  2668. /* singular vectors of L in WORK(IR) */
  2669. /* (CWorkspace: need M*M) */
  2670. /* (RWorkspace: need BDSPAC) */
  2671. zbdsqr_("U", m, m, &c__0, &c__0, &s[1], &rwork[ie], &work[
  2672. ir], &ldwrkr, cdum, &c__1, cdum, &c__1, &rwork[
  2673. irwork], info);
  2674. iu = itauq;
  2675. /* Multiply right singular vectors of L in WORK(IR) by Q */
  2676. /* in A, storing result in WORK(IU) and copying to A */
  2677. /* (CWorkspace: need M*M+M, prefer M*M+M*N) */
  2678. /* (RWorkspace: 0) */
  2679. i__2 = *n;
  2680. i__3 = chunk;
  2681. for (i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
  2682. i__3) {
  2683. /* Computing MIN */
  2684. i__4 = *n - i__ + 1;
  2685. blk = f2cmin(i__4,chunk);
  2686. zgemm_("N", "N", m, &blk, m, &c_b2, &work[ir], &
  2687. ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b1, &
  2688. work[iu], &ldwrku);
  2689. zlacpy_("F", m, &blk, &work[iu], &ldwrku, &a[i__ *
  2690. a_dim1 + 1], lda);
  2691. /* L30: */
  2692. }
  2693. } else {
  2694. /* Insufficient workspace for a fast algorithm */
  2695. ie = 1;
  2696. itauq = 1;
  2697. itaup = itauq + *m;
  2698. iwork = itaup + *m;
  2699. /* Bidiagonalize A */
  2700. /* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) */
  2701. /* (RWorkspace: need M) */
  2702. i__3 = *lwork - iwork + 1;
  2703. zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[
  2704. itauq], &work[itaup], &work[iwork], &i__3, &ierr);
  2705. /* Generate right vectors bidiagonalizing A */
  2706. /* (CWorkspace: need 3*M, prefer 2*M+M*NB) */
  2707. /* (RWorkspace: 0) */
  2708. i__3 = *lwork - iwork + 1;
  2709. zungbr_("P", m, n, m, &a[a_offset], lda, &work[itaup], &
  2710. work[iwork], &i__3, &ierr);
  2711. irwork = ie + *m;
  2712. /* Perform bidiagonal QR iteration, computing right */
  2713. /* singular vectors of A in A */
  2714. /* (CWorkspace: 0) */
  2715. /* (RWorkspace: need BDSPAC) */
  2716. zbdsqr_("L", m, n, &c__0, &c__0, &s[1], &rwork[ie], &a[
  2717. a_offset], lda, cdum, &c__1, cdum, &c__1, &rwork[
  2718. irwork], info);
  2719. }
  2720. } else if (wntvo && wntuas) {
  2721. /* Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O') */
  2722. /* M right singular vectors to be overwritten on A and */
  2723. /* M left singular vectors to be computed in U */
  2724. if (*lwork >= *m * *m + *m * 3) {
  2725. /* Sufficient workspace for a fast algorithm */
  2726. ir = 1;
  2727. /* Computing MAX */
  2728. i__3 = wrkbl, i__2 = *lda * *n;
  2729. if (*lwork >= f2cmax(i__3,i__2) + *lda * *m) {
  2730. /* WORK(IU) is LDA by N and WORK(IR) is LDA by M */
  2731. ldwrku = *lda;
  2732. chunk = *n;
  2733. ldwrkr = *lda;
  2734. } else /* if(complicated condition) */ {
  2735. /* Computing MAX */
  2736. i__3 = wrkbl, i__2 = *lda * *n;
  2737. if (*lwork >= f2cmax(i__3,i__2) + *m * *m) {
  2738. /* WORK(IU) is LDA by N and WORK(IR) is M by M */
  2739. ldwrku = *lda;
  2740. chunk = *n;
  2741. ldwrkr = *m;
  2742. } else {
  2743. /* WORK(IU) is M by CHUNK and WORK(IR) is M by M */
  2744. ldwrku = *m;
  2745. chunk = (*lwork - *m * *m) / *m;
  2746. ldwrkr = *m;
  2747. }
  2748. }
  2749. itau = ir + ldwrkr * *m;
  2750. iwork = itau + *m;
  2751. /* Compute A=L*Q */
  2752. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2753. /* (RWorkspace: 0) */
  2754. i__3 = *lwork - iwork + 1;
  2755. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  2756. , &i__3, &ierr);
  2757. /* Copy L to U, zeroing about above it */
  2758. zlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
  2759. i__3 = *m - 1;
  2760. i__2 = *m - 1;
  2761. zlaset_("U", &i__3, &i__2, &c_b1, &c_b1, &u[(u_dim1 << 1)
  2762. + 1], ldu);
  2763. /* Generate Q in A */
  2764. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2765. /* (RWorkspace: 0) */
  2766. i__3 = *lwork - iwork + 1;
  2767. zunglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[
  2768. iwork], &i__3, &ierr);
  2769. ie = 1;
  2770. itauq = itau;
  2771. itaup = itauq + *m;
  2772. iwork = itaup + *m;
  2773. /* Bidiagonalize L in U, copying result to WORK(IR) */
  2774. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) */
  2775. /* (RWorkspace: need M) */
  2776. i__3 = *lwork - iwork + 1;
  2777. zgebrd_(m, m, &u[u_offset], ldu, &s[1], &rwork[ie], &work[
  2778. itauq], &work[itaup], &work[iwork], &i__3, &ierr);
  2779. zlacpy_("U", m, m, &u[u_offset], ldu, &work[ir], &ldwrkr);
  2780. /* Generate right vectors bidiagonalizing L in WORK(IR) */
  2781. /* (CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB) */
  2782. /* (RWorkspace: 0) */
  2783. i__3 = *lwork - iwork + 1;
  2784. zungbr_("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &
  2785. work[iwork], &i__3, &ierr);
  2786. /* Generate left vectors bidiagonalizing L in U */
  2787. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) */
  2788. /* (RWorkspace: 0) */
  2789. i__3 = *lwork - iwork + 1;
  2790. zungbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &
  2791. work[iwork], &i__3, &ierr);
  2792. irwork = ie + *m;
  2793. /* Perform bidiagonal QR iteration, computing left */
  2794. /* singular vectors of L in U, and computing right */
  2795. /* singular vectors of L in WORK(IR) */
  2796. /* (CWorkspace: need M*M) */
  2797. /* (RWorkspace: need BDSPAC) */
  2798. zbdsqr_("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[ir],
  2799. &ldwrkr, &u[u_offset], ldu, cdum, &c__1, &rwork[
  2800. irwork], info);
  2801. iu = itauq;
  2802. /* Multiply right singular vectors of L in WORK(IR) by Q */
  2803. /* in A, storing result in WORK(IU) and copying to A */
  2804. /* (CWorkspace: need M*M+M, prefer M*M+M*N)) */
  2805. /* (RWorkspace: 0) */
  2806. i__3 = *n;
  2807. i__2 = chunk;
  2808. for (i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ +=
  2809. i__2) {
  2810. /* Computing MIN */
  2811. i__4 = *n - i__ + 1;
  2812. blk = f2cmin(i__4,chunk);
  2813. zgemm_("N", "N", m, &blk, m, &c_b2, &work[ir], &
  2814. ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b1, &
  2815. work[iu], &ldwrku);
  2816. zlacpy_("F", m, &blk, &work[iu], &ldwrku, &a[i__ *
  2817. a_dim1 + 1], lda);
  2818. /* L40: */
  2819. }
  2820. } else {
  2821. /* Insufficient workspace for a fast algorithm */
  2822. itau = 1;
  2823. iwork = itau + *m;
  2824. /* Compute A=L*Q */
  2825. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  2826. /* (RWorkspace: 0) */
  2827. i__2 = *lwork - iwork + 1;
  2828. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
  2829. , &i__2, &ierr);
  2830. /* Copy L to U, zeroing out above it */
  2831. zlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
  2832. i__2 = *m - 1;
  2833. i__3 = *m - 1;
  2834. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &u[(u_dim1 << 1)
  2835. + 1], ldu);
  2836. /* Generate Q in A */
  2837. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  2838. /* (RWorkspace: 0) */
  2839. i__2 = *lwork - iwork + 1;
  2840. zunglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[
  2841. iwork], &i__2, &ierr);
  2842. ie = 1;
  2843. itauq = itau;
  2844. itaup = itauq + *m;
  2845. iwork = itaup + *m;
  2846. /* Bidiagonalize L in U */
  2847. /* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) */
  2848. /* (RWorkspace: need M) */
  2849. i__2 = *lwork - iwork + 1;
  2850. zgebrd_(m, m, &u[u_offset], ldu, &s[1], &rwork[ie], &work[
  2851. itauq], &work[itaup], &work[iwork], &i__2, &ierr);
  2852. /* Multiply right vectors bidiagonalizing L by Q in A */
  2853. /* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) */
  2854. /* (RWorkspace: 0) */
  2855. i__2 = *lwork - iwork + 1;
  2856. zunmbr_("P", "L", "C", m, n, m, &u[u_offset], ldu, &work[
  2857. itaup], &a[a_offset], lda, &work[iwork], &i__2, &
  2858. ierr);
  2859. /* Generate left vectors bidiagonalizing L in U */
  2860. /* (CWorkspace: need 3*M, prefer 2*M+M*NB) */
  2861. /* (RWorkspace: 0) */
  2862. i__2 = *lwork - iwork + 1;
  2863. zungbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &
  2864. work[iwork], &i__2, &ierr);
  2865. irwork = ie + *m;
  2866. /* Perform bidiagonal QR iteration, computing left */
  2867. /* singular vectors of A in U and computing right */
  2868. /* singular vectors of A in A */
  2869. /* (CWorkspace: 0) */
  2870. /* (RWorkspace: need BDSPAC) */
  2871. zbdsqr_("U", m, n, m, &c__0, &s[1], &rwork[ie], &a[
  2872. a_offset], lda, &u[u_offset], ldu, cdum, &c__1, &
  2873. rwork[irwork], info);
  2874. }
  2875. } else if (wntvs) {
  2876. if (wntun) {
  2877. /* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */
  2878. /* M right singular vectors to be computed in VT and */
  2879. /* no left singular vectors to be computed */
  2880. if (*lwork >= *m * *m + *m * 3) {
  2881. /* Sufficient workspace for a fast algorithm */
  2882. ir = 1;
  2883. if (*lwork >= wrkbl + *lda * *m) {
  2884. /* WORK(IR) is LDA by M */
  2885. ldwrkr = *lda;
  2886. } else {
  2887. /* WORK(IR) is M by M */
  2888. ldwrkr = *m;
  2889. }
  2890. itau = ir + ldwrkr * *m;
  2891. iwork = itau + *m;
  2892. /* Compute A=L*Q */
  2893. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2894. /* (RWorkspace: 0) */
  2895. i__2 = *lwork - iwork + 1;
  2896. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2897. iwork], &i__2, &ierr);
  2898. /* Copy L to WORK(IR), zeroing out above it */
  2899. zlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &
  2900. ldwrkr);
  2901. i__2 = *m - 1;
  2902. i__3 = *m - 1;
  2903. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &work[ir +
  2904. ldwrkr], &ldwrkr);
  2905. /* Generate Q in A */
  2906. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  2907. /* (RWorkspace: 0) */
  2908. i__2 = *lwork - iwork + 1;
  2909. zunglq_(m, n, m, &a[a_offset], lda, &work[itau], &
  2910. work[iwork], &i__2, &ierr);
  2911. ie = 1;
  2912. itauq = itau;
  2913. itaup = itauq + *m;
  2914. iwork = itaup + *m;
  2915. /* Bidiagonalize L in WORK(IR) */
  2916. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) */
  2917. /* (RWorkspace: need M) */
  2918. i__2 = *lwork - iwork + 1;
  2919. zgebrd_(m, m, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
  2920. work[itauq], &work[itaup], &work[iwork], &
  2921. i__2, &ierr);
  2922. /* Generate right vectors bidiagonalizing L in */
  2923. /* WORK(IR) */
  2924. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+(M-1)*NB) */
  2925. /* (RWorkspace: 0) */
  2926. i__2 = *lwork - iwork + 1;
  2927. zungbr_("P", m, m, m, &work[ir], &ldwrkr, &work[itaup]
  2928. , &work[iwork], &i__2, &ierr);
  2929. irwork = ie + *m;
  2930. /* Perform bidiagonal QR iteration, computing right */
  2931. /* singular vectors of L in WORK(IR) */
  2932. /* (CWorkspace: need M*M) */
  2933. /* (RWorkspace: need BDSPAC) */
  2934. zbdsqr_("U", m, m, &c__0, &c__0, &s[1], &rwork[ie], &
  2935. work[ir], &ldwrkr, cdum, &c__1, cdum, &c__1, &
  2936. rwork[irwork], info);
  2937. /* Multiply right singular vectors of L in WORK(IR) by */
  2938. /* Q in A, storing result in VT */
  2939. /* (CWorkspace: need M*M) */
  2940. /* (RWorkspace: 0) */
  2941. zgemm_("N", "N", m, n, m, &c_b2, &work[ir], &ldwrkr, &
  2942. a[a_offset], lda, &c_b1, &vt[vt_offset], ldvt);
  2943. } else {
  2944. /* Insufficient workspace for a fast algorithm */
  2945. itau = 1;
  2946. iwork = itau + *m;
  2947. /* Compute A=L*Q */
  2948. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  2949. /* (RWorkspace: 0) */
  2950. i__2 = *lwork - iwork + 1;
  2951. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  2952. iwork], &i__2, &ierr);
  2953. /* Copy result to VT */
  2954. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  2955. ldvt);
  2956. /* Generate Q in VT */
  2957. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  2958. /* (RWorkspace: 0) */
  2959. i__2 = *lwork - iwork + 1;
  2960. zunglq_(m, n, m, &vt[vt_offset], ldvt, &work[itau], &
  2961. work[iwork], &i__2, &ierr);
  2962. ie = 1;
  2963. itauq = itau;
  2964. itaup = itauq + *m;
  2965. iwork = itaup + *m;
  2966. /* Zero out above L in A */
  2967. i__2 = *m - 1;
  2968. i__3 = *m - 1;
  2969. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 <<
  2970. 1) + 1], lda);
  2971. /* Bidiagonalize L in A */
  2972. /* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) */
  2973. /* (RWorkspace: need M) */
  2974. i__2 = *lwork - iwork + 1;
  2975. zgebrd_(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &
  2976. work[itauq], &work[itaup], &work[iwork], &
  2977. i__2, &ierr);
  2978. /* Multiply right vectors bidiagonalizing L by Q in VT */
  2979. /* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) */
  2980. /* (RWorkspace: 0) */
  2981. i__2 = *lwork - iwork + 1;
  2982. zunmbr_("P", "L", "C", m, n, m, &a[a_offset], lda, &
  2983. work[itaup], &vt[vt_offset], ldvt, &work[
  2984. iwork], &i__2, &ierr);
  2985. irwork = ie + *m;
  2986. /* Perform bidiagonal QR iteration, computing right */
  2987. /* singular vectors of A in VT */
  2988. /* (CWorkspace: 0) */
  2989. /* (RWorkspace: need BDSPAC) */
  2990. zbdsqr_("U", m, n, &c__0, &c__0, &s[1], &rwork[ie], &
  2991. vt[vt_offset], ldvt, cdum, &c__1, cdum, &c__1,
  2992. &rwork[irwork], info);
  2993. }
  2994. } else if (wntuo) {
  2995. /* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */
  2996. /* M right singular vectors to be computed in VT and */
  2997. /* M left singular vectors to be overwritten on A */
  2998. if (*lwork >= (*m << 1) * *m + *m * 3) {
  2999. /* Sufficient workspace for a fast algorithm */
  3000. iu = 1;
  3001. if (*lwork >= wrkbl + (*lda << 1) * *m) {
  3002. /* WORK(IU) is LDA by M and WORK(IR) is LDA by M */
  3003. ldwrku = *lda;
  3004. ir = iu + ldwrku * *m;
  3005. ldwrkr = *lda;
  3006. } else if (*lwork >= wrkbl + (*lda + *m) * *m) {
  3007. /* WORK(IU) is LDA by M and WORK(IR) is M by M */
  3008. ldwrku = *lda;
  3009. ir = iu + ldwrku * *m;
  3010. ldwrkr = *m;
  3011. } else {
  3012. /* WORK(IU) is M by M and WORK(IR) is M by M */
  3013. ldwrku = *m;
  3014. ir = iu + ldwrku * *m;
  3015. ldwrkr = *m;
  3016. }
  3017. itau = ir + ldwrkr * *m;
  3018. iwork = itau + *m;
  3019. /* Compute A=L*Q */
  3020. /* (CWorkspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */
  3021. /* (RWorkspace: 0) */
  3022. i__2 = *lwork - iwork + 1;
  3023. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3024. iwork], &i__2, &ierr);
  3025. /* Copy L to WORK(IU), zeroing out below it */
  3026. zlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &
  3027. ldwrku);
  3028. i__2 = *m - 1;
  3029. i__3 = *m - 1;
  3030. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &work[iu +
  3031. ldwrku], &ldwrku);
  3032. /* Generate Q in A */
  3033. /* (CWorkspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */
  3034. /* (RWorkspace: 0) */
  3035. i__2 = *lwork - iwork + 1;
  3036. zunglq_(m, n, m, &a[a_offset], lda, &work[itau], &
  3037. work[iwork], &i__2, &ierr);
  3038. ie = 1;
  3039. itauq = itau;
  3040. itaup = itauq + *m;
  3041. iwork = itaup + *m;
  3042. /* Bidiagonalize L in WORK(IU), copying result to */
  3043. /* WORK(IR) */
  3044. /* (CWorkspace: need 2*M*M+3*M, */
  3045. /* prefer 2*M*M+2*M+2*M*NB) */
  3046. /* (RWorkspace: need M) */
  3047. i__2 = *lwork - iwork + 1;
  3048. zgebrd_(m, m, &work[iu], &ldwrku, &s[1], &rwork[ie], &
  3049. work[itauq], &work[itaup], &work[iwork], &
  3050. i__2, &ierr);
  3051. zlacpy_("L", m, m, &work[iu], &ldwrku, &work[ir], &
  3052. ldwrkr);
  3053. /* Generate right bidiagonalizing vectors in WORK(IU) */
  3054. /* (CWorkspace: need 2*M*M+3*M-1, */
  3055. /* prefer 2*M*M+2*M+(M-1)*NB) */
  3056. /* (RWorkspace: 0) */
  3057. i__2 = *lwork - iwork + 1;
  3058. zungbr_("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
  3059. , &work[iwork], &i__2, &ierr);
  3060. /* Generate left bidiagonalizing vectors in WORK(IR) */
  3061. /* (CWorkspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB) */
  3062. /* (RWorkspace: 0) */
  3063. i__2 = *lwork - iwork + 1;
  3064. zungbr_("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq]
  3065. , &work[iwork], &i__2, &ierr);
  3066. irwork = ie + *m;
  3067. /* Perform bidiagonal QR iteration, computing left */
  3068. /* singular vectors of L in WORK(IR) and computing */
  3069. /* right singular vectors of L in WORK(IU) */
  3070. /* (CWorkspace: need 2*M*M) */
  3071. /* (RWorkspace: need BDSPAC) */
  3072. zbdsqr_("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[
  3073. iu], &ldwrku, &work[ir], &ldwrkr, cdum, &c__1,
  3074. &rwork[irwork], info);
  3075. /* Multiply right singular vectors of L in WORK(IU) by */
  3076. /* Q in A, storing result in VT */
  3077. /* (CWorkspace: need M*M) */
  3078. /* (RWorkspace: 0) */
  3079. zgemm_("N", "N", m, n, m, &c_b2, &work[iu], &ldwrku, &
  3080. a[a_offset], lda, &c_b1, &vt[vt_offset], ldvt);
  3081. /* Copy left singular vectors of L to A */
  3082. /* (CWorkspace: need M*M) */
  3083. /* (RWorkspace: 0) */
  3084. zlacpy_("F", m, m, &work[ir], &ldwrkr, &a[a_offset],
  3085. lda);
  3086. } else {
  3087. /* Insufficient workspace for a fast algorithm */
  3088. itau = 1;
  3089. iwork = itau + *m;
  3090. /* Compute A=L*Q, copying result to VT */
  3091. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  3092. /* (RWorkspace: 0) */
  3093. i__2 = *lwork - iwork + 1;
  3094. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3095. iwork], &i__2, &ierr);
  3096. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  3097. ldvt);
  3098. /* Generate Q in VT */
  3099. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  3100. /* (RWorkspace: 0) */
  3101. i__2 = *lwork - iwork + 1;
  3102. zunglq_(m, n, m, &vt[vt_offset], ldvt, &work[itau], &
  3103. work[iwork], &i__2, &ierr);
  3104. ie = 1;
  3105. itauq = itau;
  3106. itaup = itauq + *m;
  3107. iwork = itaup + *m;
  3108. /* Zero out above L in A */
  3109. i__2 = *m - 1;
  3110. i__3 = *m - 1;
  3111. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 <<
  3112. 1) + 1], lda);
  3113. /* Bidiagonalize L in A */
  3114. /* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) */
  3115. /* (RWorkspace: need M) */
  3116. i__2 = *lwork - iwork + 1;
  3117. zgebrd_(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &
  3118. work[itauq], &work[itaup], &work[iwork], &
  3119. i__2, &ierr);
  3120. /* Multiply right vectors bidiagonalizing L by Q in VT */
  3121. /* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) */
  3122. /* (RWorkspace: 0) */
  3123. i__2 = *lwork - iwork + 1;
  3124. zunmbr_("P", "L", "C", m, n, m, &a[a_offset], lda, &
  3125. work[itaup], &vt[vt_offset], ldvt, &work[
  3126. iwork], &i__2, &ierr);
  3127. /* Generate left bidiagonalizing vectors of L in A */
  3128. /* (CWorkspace: need 3*M, prefer 2*M+M*NB) */
  3129. /* (RWorkspace: 0) */
  3130. i__2 = *lwork - iwork + 1;
  3131. zungbr_("Q", m, m, m, &a[a_offset], lda, &work[itauq],
  3132. &work[iwork], &i__2, &ierr);
  3133. irwork = ie + *m;
  3134. /* Perform bidiagonal QR iteration, computing left */
  3135. /* singular vectors of A in A and computing right */
  3136. /* singular vectors of A in VT */
  3137. /* (CWorkspace: 0) */
  3138. /* (RWorkspace: need BDSPAC) */
  3139. zbdsqr_("U", m, n, m, &c__0, &s[1], &rwork[ie], &vt[
  3140. vt_offset], ldvt, &a[a_offset], lda, cdum, &
  3141. c__1, &rwork[irwork], info);
  3142. }
  3143. } else if (wntuas) {
  3144. /* Path 6t(N much larger than M, JOBU='S' or 'A', */
  3145. /* JOBVT='S') */
  3146. /* M right singular vectors to be computed in VT and */
  3147. /* M left singular vectors to be computed in U */
  3148. if (*lwork >= *m * *m + *m * 3) {
  3149. /* Sufficient workspace for a fast algorithm */
  3150. iu = 1;
  3151. if (*lwork >= wrkbl + *lda * *m) {
  3152. /* WORK(IU) is LDA by N */
  3153. ldwrku = *lda;
  3154. } else {
  3155. /* WORK(IU) is LDA by M */
  3156. ldwrku = *m;
  3157. }
  3158. itau = iu + ldwrku * *m;
  3159. iwork = itau + *m;
  3160. /* Compute A=L*Q */
  3161. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  3162. /* (RWorkspace: 0) */
  3163. i__2 = *lwork - iwork + 1;
  3164. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3165. iwork], &i__2, &ierr);
  3166. /* Copy L to WORK(IU), zeroing out above it */
  3167. zlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &
  3168. ldwrku);
  3169. i__2 = *m - 1;
  3170. i__3 = *m - 1;
  3171. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &work[iu +
  3172. ldwrku], &ldwrku);
  3173. /* Generate Q in A */
  3174. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  3175. /* (RWorkspace: 0) */
  3176. i__2 = *lwork - iwork + 1;
  3177. zunglq_(m, n, m, &a[a_offset], lda, &work[itau], &
  3178. work[iwork], &i__2, &ierr);
  3179. ie = 1;
  3180. itauq = itau;
  3181. itaup = itauq + *m;
  3182. iwork = itaup + *m;
  3183. /* Bidiagonalize L in WORK(IU), copying result to U */
  3184. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) */
  3185. /* (RWorkspace: need M) */
  3186. i__2 = *lwork - iwork + 1;
  3187. zgebrd_(m, m, &work[iu], &ldwrku, &s[1], &rwork[ie], &
  3188. work[itauq], &work[itaup], &work[iwork], &
  3189. i__2, &ierr);
  3190. zlacpy_("L", m, m, &work[iu], &ldwrku, &u[u_offset],
  3191. ldu);
  3192. /* Generate right bidiagonalizing vectors in WORK(IU) */
  3193. /* (CWorkspace: need M*M+3*M-1, */
  3194. /* prefer M*M+2*M+(M-1)*NB) */
  3195. /* (RWorkspace: 0) */
  3196. i__2 = *lwork - iwork + 1;
  3197. zungbr_("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
  3198. , &work[iwork], &i__2, &ierr);
  3199. /* Generate left bidiagonalizing vectors in U */
  3200. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) */
  3201. /* (RWorkspace: 0) */
  3202. i__2 = *lwork - iwork + 1;
  3203. zungbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
  3204. &work[iwork], &i__2, &ierr);
  3205. irwork = ie + *m;
  3206. /* Perform bidiagonal QR iteration, computing left */
  3207. /* singular vectors of L in U and computing right */
  3208. /* singular vectors of L in WORK(IU) */
  3209. /* (CWorkspace: need M*M) */
  3210. /* (RWorkspace: need BDSPAC) */
  3211. zbdsqr_("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[
  3212. iu], &ldwrku, &u[u_offset], ldu, cdum, &c__1,
  3213. &rwork[irwork], info);
  3214. /* Multiply right singular vectors of L in WORK(IU) by */
  3215. /* Q in A, storing result in VT */
  3216. /* (CWorkspace: need M*M) */
  3217. /* (RWorkspace: 0) */
  3218. zgemm_("N", "N", m, n, m, &c_b2, &work[iu], &ldwrku, &
  3219. a[a_offset], lda, &c_b1, &vt[vt_offset], ldvt);
  3220. } else {
  3221. /* Insufficient workspace for a fast algorithm */
  3222. itau = 1;
  3223. iwork = itau + *m;
  3224. /* Compute A=L*Q, copying result to VT */
  3225. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  3226. /* (RWorkspace: 0) */
  3227. i__2 = *lwork - iwork + 1;
  3228. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3229. iwork], &i__2, &ierr);
  3230. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  3231. ldvt);
  3232. /* Generate Q in VT */
  3233. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  3234. /* (RWorkspace: 0) */
  3235. i__2 = *lwork - iwork + 1;
  3236. zunglq_(m, n, m, &vt[vt_offset], ldvt, &work[itau], &
  3237. work[iwork], &i__2, &ierr);
  3238. /* Copy L to U, zeroing out above it */
  3239. zlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset],
  3240. ldu);
  3241. i__2 = *m - 1;
  3242. i__3 = *m - 1;
  3243. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &u[(u_dim1 <<
  3244. 1) + 1], ldu);
  3245. ie = 1;
  3246. itauq = itau;
  3247. itaup = itauq + *m;
  3248. iwork = itaup + *m;
  3249. /* Bidiagonalize L in U */
  3250. /* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) */
  3251. /* (RWorkspace: need M) */
  3252. i__2 = *lwork - iwork + 1;
  3253. zgebrd_(m, m, &u[u_offset], ldu, &s[1], &rwork[ie], &
  3254. work[itauq], &work[itaup], &work[iwork], &
  3255. i__2, &ierr);
  3256. /* Multiply right bidiagonalizing vectors in U by Q */
  3257. /* in VT */
  3258. /* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) */
  3259. /* (RWorkspace: 0) */
  3260. i__2 = *lwork - iwork + 1;
  3261. zunmbr_("P", "L", "C", m, n, m, &u[u_offset], ldu, &
  3262. work[itaup], &vt[vt_offset], ldvt, &work[
  3263. iwork], &i__2, &ierr);
  3264. /* Generate left bidiagonalizing vectors in U */
  3265. /* (CWorkspace: need 3*M, prefer 2*M+M*NB) */
  3266. /* (RWorkspace: 0) */
  3267. i__2 = *lwork - iwork + 1;
  3268. zungbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
  3269. &work[iwork], &i__2, &ierr);
  3270. irwork = ie + *m;
  3271. /* Perform bidiagonal QR iteration, computing left */
  3272. /* singular vectors of A in U and computing right */
  3273. /* singular vectors of A in VT */
  3274. /* (CWorkspace: 0) */
  3275. /* (RWorkspace: need BDSPAC) */
  3276. zbdsqr_("U", m, n, m, &c__0, &s[1], &rwork[ie], &vt[
  3277. vt_offset], ldvt, &u[u_offset], ldu, cdum, &
  3278. c__1, &rwork[irwork], info);
  3279. }
  3280. }
  3281. } else if (wntva) {
  3282. if (wntun) {
  3283. /* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */
  3284. /* N right singular vectors to be computed in VT and */
  3285. /* no left singular vectors to be computed */
  3286. /* Computing MAX */
  3287. i__2 = *n + *m, i__3 = *m * 3;
  3288. if (*lwork >= *m * *m + f2cmax(i__2,i__3)) {
  3289. /* Sufficient workspace for a fast algorithm */
  3290. ir = 1;
  3291. if (*lwork >= wrkbl + *lda * *m) {
  3292. /* WORK(IR) is LDA by M */
  3293. ldwrkr = *lda;
  3294. } else {
  3295. /* WORK(IR) is M by M */
  3296. ldwrkr = *m;
  3297. }
  3298. itau = ir + ldwrkr * *m;
  3299. iwork = itau + *m;
  3300. /* Compute A=L*Q, copying result to VT */
  3301. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  3302. /* (RWorkspace: 0) */
  3303. i__2 = *lwork - iwork + 1;
  3304. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3305. iwork], &i__2, &ierr);
  3306. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  3307. ldvt);
  3308. /* Copy L to WORK(IR), zeroing out above it */
  3309. zlacpy_("L", m, m, &a[a_offset], lda, &work[ir], &
  3310. ldwrkr);
  3311. i__2 = *m - 1;
  3312. i__3 = *m - 1;
  3313. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &work[ir +
  3314. ldwrkr], &ldwrkr);
  3315. /* Generate Q in VT */
  3316. /* (CWorkspace: need M*M+M+N, prefer M*M+M+N*NB) */
  3317. /* (RWorkspace: 0) */
  3318. i__2 = *lwork - iwork + 1;
  3319. zunglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  3320. work[iwork], &i__2, &ierr);
  3321. ie = 1;
  3322. itauq = itau;
  3323. itaup = itauq + *m;
  3324. iwork = itaup + *m;
  3325. /* Bidiagonalize L in WORK(IR) */
  3326. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) */
  3327. /* (RWorkspace: need M) */
  3328. i__2 = *lwork - iwork + 1;
  3329. zgebrd_(m, m, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
  3330. work[itauq], &work[itaup], &work[iwork], &
  3331. i__2, &ierr);
  3332. /* Generate right bidiagonalizing vectors in WORK(IR) */
  3333. /* (CWorkspace: need M*M+3*M-1, */
  3334. /* prefer M*M+2*M+(M-1)*NB) */
  3335. /* (RWorkspace: 0) */
  3336. i__2 = *lwork - iwork + 1;
  3337. zungbr_("P", m, m, m, &work[ir], &ldwrkr, &work[itaup]
  3338. , &work[iwork], &i__2, &ierr);
  3339. irwork = ie + *m;
  3340. /* Perform bidiagonal QR iteration, computing right */
  3341. /* singular vectors of L in WORK(IR) */
  3342. /* (CWorkspace: need M*M) */
  3343. /* (RWorkspace: need BDSPAC) */
  3344. zbdsqr_("U", m, m, &c__0, &c__0, &s[1], &rwork[ie], &
  3345. work[ir], &ldwrkr, cdum, &c__1, cdum, &c__1, &
  3346. rwork[irwork], info);
  3347. /* Multiply right singular vectors of L in WORK(IR) by */
  3348. /* Q in VT, storing result in A */
  3349. /* (CWorkspace: need M*M) */
  3350. /* (RWorkspace: 0) */
  3351. zgemm_("N", "N", m, n, m, &c_b2, &work[ir], &ldwrkr, &
  3352. vt[vt_offset], ldvt, &c_b1, &a[a_offset], lda);
  3353. /* Copy right singular vectors of A from A to VT */
  3354. zlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset],
  3355. ldvt);
  3356. } else {
  3357. /* Insufficient workspace for a fast algorithm */
  3358. itau = 1;
  3359. iwork = itau + *m;
  3360. /* Compute A=L*Q, copying result to VT */
  3361. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  3362. /* (RWorkspace: 0) */
  3363. i__2 = *lwork - iwork + 1;
  3364. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3365. iwork], &i__2, &ierr);
  3366. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  3367. ldvt);
  3368. /* Generate Q in VT */
  3369. /* (CWorkspace: need M+N, prefer M+N*NB) */
  3370. /* (RWorkspace: 0) */
  3371. i__2 = *lwork - iwork + 1;
  3372. zunglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  3373. work[iwork], &i__2, &ierr);
  3374. ie = 1;
  3375. itauq = itau;
  3376. itaup = itauq + *m;
  3377. iwork = itaup + *m;
  3378. /* Zero out above L in A */
  3379. i__2 = *m - 1;
  3380. i__3 = *m - 1;
  3381. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 <<
  3382. 1) + 1], lda);
  3383. /* Bidiagonalize L in A */
  3384. /* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) */
  3385. /* (RWorkspace: need M) */
  3386. i__2 = *lwork - iwork + 1;
  3387. zgebrd_(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &
  3388. work[itauq], &work[itaup], &work[iwork], &
  3389. i__2, &ierr);
  3390. /* Multiply right bidiagonalizing vectors in A by Q */
  3391. /* in VT */
  3392. /* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) */
  3393. /* (RWorkspace: 0) */
  3394. i__2 = *lwork - iwork + 1;
  3395. zunmbr_("P", "L", "C", m, n, m, &a[a_offset], lda, &
  3396. work[itaup], &vt[vt_offset], ldvt, &work[
  3397. iwork], &i__2, &ierr);
  3398. irwork = ie + *m;
  3399. /* Perform bidiagonal QR iteration, computing right */
  3400. /* singular vectors of A in VT */
  3401. /* (CWorkspace: 0) */
  3402. /* (RWorkspace: need BDSPAC) */
  3403. zbdsqr_("U", m, n, &c__0, &c__0, &s[1], &rwork[ie], &
  3404. vt[vt_offset], ldvt, cdum, &c__1, cdum, &c__1,
  3405. &rwork[irwork], info);
  3406. }
  3407. } else if (wntuo) {
  3408. /* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */
  3409. /* N right singular vectors to be computed in VT and */
  3410. /* M left singular vectors to be overwritten on A */
  3411. /* Computing MAX */
  3412. i__2 = *n + *m, i__3 = *m * 3;
  3413. if (*lwork >= (*m << 1) * *m + f2cmax(i__2,i__3)) {
  3414. /* Sufficient workspace for a fast algorithm */
  3415. iu = 1;
  3416. if (*lwork >= wrkbl + (*lda << 1) * *m) {
  3417. /* WORK(IU) is LDA by M and WORK(IR) is LDA by M */
  3418. ldwrku = *lda;
  3419. ir = iu + ldwrku * *m;
  3420. ldwrkr = *lda;
  3421. } else if (*lwork >= wrkbl + (*lda + *m) * *m) {
  3422. /* WORK(IU) is LDA by M and WORK(IR) is M by M */
  3423. ldwrku = *lda;
  3424. ir = iu + ldwrku * *m;
  3425. ldwrkr = *m;
  3426. } else {
  3427. /* WORK(IU) is M by M and WORK(IR) is M by M */
  3428. ldwrku = *m;
  3429. ir = iu + ldwrku * *m;
  3430. ldwrkr = *m;
  3431. }
  3432. itau = ir + ldwrkr * *m;
  3433. iwork = itau + *m;
  3434. /* Compute A=L*Q, copying result to VT */
  3435. /* (CWorkspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */
  3436. /* (RWorkspace: 0) */
  3437. i__2 = *lwork - iwork + 1;
  3438. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3439. iwork], &i__2, &ierr);
  3440. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  3441. ldvt);
  3442. /* Generate Q in VT */
  3443. /* (CWorkspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB) */
  3444. /* (RWorkspace: 0) */
  3445. i__2 = *lwork - iwork + 1;
  3446. zunglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  3447. work[iwork], &i__2, &ierr);
  3448. /* Copy L to WORK(IU), zeroing out above it */
  3449. zlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &
  3450. ldwrku);
  3451. i__2 = *m - 1;
  3452. i__3 = *m - 1;
  3453. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &work[iu +
  3454. ldwrku], &ldwrku);
  3455. ie = 1;
  3456. itauq = itau;
  3457. itaup = itauq + *m;
  3458. iwork = itaup + *m;
  3459. /* Bidiagonalize L in WORK(IU), copying result to */
  3460. /* WORK(IR) */
  3461. /* (CWorkspace: need 2*M*M+3*M, */
  3462. /* prefer 2*M*M+2*M+2*M*NB) */
  3463. /* (RWorkspace: need M) */
  3464. i__2 = *lwork - iwork + 1;
  3465. zgebrd_(m, m, &work[iu], &ldwrku, &s[1], &rwork[ie], &
  3466. work[itauq], &work[itaup], &work[iwork], &
  3467. i__2, &ierr);
  3468. zlacpy_("L", m, m, &work[iu], &ldwrku, &work[ir], &
  3469. ldwrkr);
  3470. /* Generate right bidiagonalizing vectors in WORK(IU) */
  3471. /* (CWorkspace: need 2*M*M+3*M-1, */
  3472. /* prefer 2*M*M+2*M+(M-1)*NB) */
  3473. /* (RWorkspace: 0) */
  3474. i__2 = *lwork - iwork + 1;
  3475. zungbr_("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
  3476. , &work[iwork], &i__2, &ierr);
  3477. /* Generate left bidiagonalizing vectors in WORK(IR) */
  3478. /* (CWorkspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB) */
  3479. /* (RWorkspace: 0) */
  3480. i__2 = *lwork - iwork + 1;
  3481. zungbr_("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq]
  3482. , &work[iwork], &i__2, &ierr);
  3483. irwork = ie + *m;
  3484. /* Perform bidiagonal QR iteration, computing left */
  3485. /* singular vectors of L in WORK(IR) and computing */
  3486. /* right singular vectors of L in WORK(IU) */
  3487. /* (CWorkspace: need 2*M*M) */
  3488. /* (RWorkspace: need BDSPAC) */
  3489. zbdsqr_("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[
  3490. iu], &ldwrku, &work[ir], &ldwrkr, cdum, &c__1,
  3491. &rwork[irwork], info);
  3492. /* Multiply right singular vectors of L in WORK(IU) by */
  3493. /* Q in VT, storing result in A */
  3494. /* (CWorkspace: need M*M) */
  3495. /* (RWorkspace: 0) */
  3496. zgemm_("N", "N", m, n, m, &c_b2, &work[iu], &ldwrku, &
  3497. vt[vt_offset], ldvt, &c_b1, &a[a_offset], lda);
  3498. /* Copy right singular vectors of A from A to VT */
  3499. zlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset],
  3500. ldvt);
  3501. /* Copy left singular vectors of A from WORK(IR) to A */
  3502. zlacpy_("F", m, m, &work[ir], &ldwrkr, &a[a_offset],
  3503. lda);
  3504. } else {
  3505. /* Insufficient workspace for a fast algorithm */
  3506. itau = 1;
  3507. iwork = itau + *m;
  3508. /* Compute A=L*Q, copying result to VT */
  3509. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  3510. /* (RWorkspace: 0) */
  3511. i__2 = *lwork - iwork + 1;
  3512. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3513. iwork], &i__2, &ierr);
  3514. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  3515. ldvt);
  3516. /* Generate Q in VT */
  3517. /* (CWorkspace: need M+N, prefer M+N*NB) */
  3518. /* (RWorkspace: 0) */
  3519. i__2 = *lwork - iwork + 1;
  3520. zunglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  3521. work[iwork], &i__2, &ierr);
  3522. ie = 1;
  3523. itauq = itau;
  3524. itaup = itauq + *m;
  3525. iwork = itaup + *m;
  3526. /* Zero out above L in A */
  3527. i__2 = *m - 1;
  3528. i__3 = *m - 1;
  3529. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 <<
  3530. 1) + 1], lda);
  3531. /* Bidiagonalize L in A */
  3532. /* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) */
  3533. /* (RWorkspace: need M) */
  3534. i__2 = *lwork - iwork + 1;
  3535. zgebrd_(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &
  3536. work[itauq], &work[itaup], &work[iwork], &
  3537. i__2, &ierr);
  3538. /* Multiply right bidiagonalizing vectors in A by Q */
  3539. /* in VT */
  3540. /* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) */
  3541. /* (RWorkspace: 0) */
  3542. i__2 = *lwork - iwork + 1;
  3543. zunmbr_("P", "L", "C", m, n, m, &a[a_offset], lda, &
  3544. work[itaup], &vt[vt_offset], ldvt, &work[
  3545. iwork], &i__2, &ierr);
  3546. /* Generate left bidiagonalizing vectors in A */
  3547. /* (CWorkspace: need 3*M, prefer 2*M+M*NB) */
  3548. /* (RWorkspace: 0) */
  3549. i__2 = *lwork - iwork + 1;
  3550. zungbr_("Q", m, m, m, &a[a_offset], lda, &work[itauq],
  3551. &work[iwork], &i__2, &ierr);
  3552. irwork = ie + *m;
  3553. /* Perform bidiagonal QR iteration, computing left */
  3554. /* singular vectors of A in A and computing right */
  3555. /* singular vectors of A in VT */
  3556. /* (CWorkspace: 0) */
  3557. /* (RWorkspace: need BDSPAC) */
  3558. zbdsqr_("U", m, n, m, &c__0, &s[1], &rwork[ie], &vt[
  3559. vt_offset], ldvt, &a[a_offset], lda, cdum, &
  3560. c__1, &rwork[irwork], info);
  3561. }
  3562. } else if (wntuas) {
  3563. /* Path 9t(N much larger than M, JOBU='S' or 'A', */
  3564. /* JOBVT='A') */
  3565. /* N right singular vectors to be computed in VT and */
  3566. /* M left singular vectors to be computed in U */
  3567. /* Computing MAX */
  3568. i__2 = *n + *m, i__3 = *m * 3;
  3569. if (*lwork >= *m * *m + f2cmax(i__2,i__3)) {
  3570. /* Sufficient workspace for a fast algorithm */
  3571. iu = 1;
  3572. if (*lwork >= wrkbl + *lda * *m) {
  3573. /* WORK(IU) is LDA by M */
  3574. ldwrku = *lda;
  3575. } else {
  3576. /* WORK(IU) is M by M */
  3577. ldwrku = *m;
  3578. }
  3579. itau = iu + ldwrku * *m;
  3580. iwork = itau + *m;
  3581. /* Compute A=L*Q, copying result to VT */
  3582. /* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) */
  3583. /* (RWorkspace: 0) */
  3584. i__2 = *lwork - iwork + 1;
  3585. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3586. iwork], &i__2, &ierr);
  3587. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  3588. ldvt);
  3589. /* Generate Q in VT */
  3590. /* (CWorkspace: need M*M+M+N, prefer M*M+M+N*NB) */
  3591. /* (RWorkspace: 0) */
  3592. i__2 = *lwork - iwork + 1;
  3593. zunglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  3594. work[iwork], &i__2, &ierr);
  3595. /* Copy L to WORK(IU), zeroing out above it */
  3596. zlacpy_("L", m, m, &a[a_offset], lda, &work[iu], &
  3597. ldwrku);
  3598. i__2 = *m - 1;
  3599. i__3 = *m - 1;
  3600. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &work[iu +
  3601. ldwrku], &ldwrku);
  3602. ie = 1;
  3603. itauq = itau;
  3604. itaup = itauq + *m;
  3605. iwork = itaup + *m;
  3606. /* Bidiagonalize L in WORK(IU), copying result to U */
  3607. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) */
  3608. /* (RWorkspace: need M) */
  3609. i__2 = *lwork - iwork + 1;
  3610. zgebrd_(m, m, &work[iu], &ldwrku, &s[1], &rwork[ie], &
  3611. work[itauq], &work[itaup], &work[iwork], &
  3612. i__2, &ierr);
  3613. zlacpy_("L", m, m, &work[iu], &ldwrku, &u[u_offset],
  3614. ldu);
  3615. /* Generate right bidiagonalizing vectors in WORK(IU) */
  3616. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+(M-1)*NB) */
  3617. /* (RWorkspace: 0) */
  3618. i__2 = *lwork - iwork + 1;
  3619. zungbr_("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
  3620. , &work[iwork], &i__2, &ierr);
  3621. /* Generate left bidiagonalizing vectors in U */
  3622. /* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) */
  3623. /* (RWorkspace: 0) */
  3624. i__2 = *lwork - iwork + 1;
  3625. zungbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
  3626. &work[iwork], &i__2, &ierr);
  3627. irwork = ie + *m;
  3628. /* Perform bidiagonal QR iteration, computing left */
  3629. /* singular vectors of L in U and computing right */
  3630. /* singular vectors of L in WORK(IU) */
  3631. /* (CWorkspace: need M*M) */
  3632. /* (RWorkspace: need BDSPAC) */
  3633. zbdsqr_("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[
  3634. iu], &ldwrku, &u[u_offset], ldu, cdum, &c__1,
  3635. &rwork[irwork], info);
  3636. /* Multiply right singular vectors of L in WORK(IU) by */
  3637. /* Q in VT, storing result in A */
  3638. /* (CWorkspace: need M*M) */
  3639. /* (RWorkspace: 0) */
  3640. zgemm_("N", "N", m, n, m, &c_b2, &work[iu], &ldwrku, &
  3641. vt[vt_offset], ldvt, &c_b1, &a[a_offset], lda);
  3642. /* Copy right singular vectors of A from A to VT */
  3643. zlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset],
  3644. ldvt);
  3645. } else {
  3646. /* Insufficient workspace for a fast algorithm */
  3647. itau = 1;
  3648. iwork = itau + *m;
  3649. /* Compute A=L*Q, copying result to VT */
  3650. /* (CWorkspace: need 2*M, prefer M+M*NB) */
  3651. /* (RWorkspace: 0) */
  3652. i__2 = *lwork - iwork + 1;
  3653. zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[
  3654. iwork], &i__2, &ierr);
  3655. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset],
  3656. ldvt);
  3657. /* Generate Q in VT */
  3658. /* (CWorkspace: need M+N, prefer M+N*NB) */
  3659. /* (RWorkspace: 0) */
  3660. i__2 = *lwork - iwork + 1;
  3661. zunglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
  3662. work[iwork], &i__2, &ierr);
  3663. /* Copy L to U, zeroing out above it */
  3664. zlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset],
  3665. ldu);
  3666. i__2 = *m - 1;
  3667. i__3 = *m - 1;
  3668. zlaset_("U", &i__2, &i__3, &c_b1, &c_b1, &u[(u_dim1 <<
  3669. 1) + 1], ldu);
  3670. ie = 1;
  3671. itauq = itau;
  3672. itaup = itauq + *m;
  3673. iwork = itaup + *m;
  3674. /* Bidiagonalize L in U */
  3675. /* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) */
  3676. /* (RWorkspace: need M) */
  3677. i__2 = *lwork - iwork + 1;
  3678. zgebrd_(m, m, &u[u_offset], ldu, &s[1], &rwork[ie], &
  3679. work[itauq], &work[itaup], &work[iwork], &
  3680. i__2, &ierr);
  3681. /* Multiply right bidiagonalizing vectors in U by Q */
  3682. /* in VT */
  3683. /* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) */
  3684. /* (RWorkspace: 0) */
  3685. i__2 = *lwork - iwork + 1;
  3686. zunmbr_("P", "L", "C", m, n, m, &u[u_offset], ldu, &
  3687. work[itaup], &vt[vt_offset], ldvt, &work[
  3688. iwork], &i__2, &ierr);
  3689. /* Generate left bidiagonalizing vectors in U */
  3690. /* (CWorkspace: need 3*M, prefer 2*M+M*NB) */
  3691. /* (RWorkspace: 0) */
  3692. i__2 = *lwork - iwork + 1;
  3693. zungbr_("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
  3694. &work[iwork], &i__2, &ierr);
  3695. irwork = ie + *m;
  3696. /* Perform bidiagonal QR iteration, computing left */
  3697. /* singular vectors of A in U and computing right */
  3698. /* singular vectors of A in VT */
  3699. /* (CWorkspace: 0) */
  3700. /* (RWorkspace: need BDSPAC) */
  3701. zbdsqr_("U", m, n, m, &c__0, &s[1], &rwork[ie], &vt[
  3702. vt_offset], ldvt, &u[u_offset], ldu, cdum, &
  3703. c__1, &rwork[irwork], info);
  3704. }
  3705. }
  3706. }
  3707. } else {
  3708. /* N .LT. MNTHR */
  3709. /* Path 10t(N greater than M, but not much larger) */
  3710. /* Reduce to bidiagonal form without LQ decomposition */
  3711. ie = 1;
  3712. itauq = 1;
  3713. itaup = itauq + *m;
  3714. iwork = itaup + *m;
  3715. /* Bidiagonalize A */
  3716. /* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) */
  3717. /* (RWorkspace: M) */
  3718. i__2 = *lwork - iwork + 1;
  3719. zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
  3720. &work[itaup], &work[iwork], &i__2, &ierr);
  3721. if (wntuas) {
  3722. /* If left singular vectors desired in U, copy result to U */
  3723. /* and generate left bidiagonalizing vectors in U */
  3724. /* (CWorkspace: need 3*M-1, prefer 2*M+(M-1)*NB) */
  3725. /* (RWorkspace: 0) */
  3726. zlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
  3727. i__2 = *lwork - iwork + 1;
  3728. zungbr_("Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[
  3729. iwork], &i__2, &ierr);
  3730. }
  3731. if (wntvas) {
  3732. /* If right singular vectors desired in VT, copy result to */
  3733. /* VT and generate right bidiagonalizing vectors in VT */
  3734. /* (CWorkspace: need 2*M+NRVT, prefer 2*M+NRVT*NB) */
  3735. /* (RWorkspace: 0) */
  3736. zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
  3737. if (wntva) {
  3738. nrvt = *n;
  3739. }
  3740. if (wntvs) {
  3741. nrvt = *m;
  3742. }
  3743. i__2 = *lwork - iwork + 1;
  3744. zungbr_("P", &nrvt, n, m, &vt[vt_offset], ldvt, &work[itaup],
  3745. &work[iwork], &i__2, &ierr);
  3746. }
  3747. if (wntuo) {
  3748. /* If left singular vectors desired in A, generate left */
  3749. /* bidiagonalizing vectors in A */
  3750. /* (CWorkspace: need 3*M-1, prefer 2*M+(M-1)*NB) */
  3751. /* (RWorkspace: 0) */
  3752. i__2 = *lwork - iwork + 1;
  3753. zungbr_("Q", m, m, n, &a[a_offset], lda, &work[itauq], &work[
  3754. iwork], &i__2, &ierr);
  3755. }
  3756. if (wntvo) {
  3757. /* If right singular vectors desired in A, generate right */
  3758. /* bidiagonalizing vectors in A */
  3759. /* (CWorkspace: need 3*M, prefer 2*M+M*NB) */
  3760. /* (RWorkspace: 0) */
  3761. i__2 = *lwork - iwork + 1;
  3762. zungbr_("P", m, n, m, &a[a_offset], lda, &work[itaup], &work[
  3763. iwork], &i__2, &ierr);
  3764. }
  3765. irwork = ie + *m;
  3766. if (wntuas || wntuo) {
  3767. nru = *m;
  3768. }
  3769. if (wntun) {
  3770. nru = 0;
  3771. }
  3772. if (wntvas || wntvo) {
  3773. ncvt = *n;
  3774. }
  3775. if (wntvn) {
  3776. ncvt = 0;
  3777. }
  3778. if (! wntuo && ! wntvo) {
  3779. /* Perform bidiagonal QR iteration, if desired, computing */
  3780. /* left singular vectors in U and computing right singular */
  3781. /* vectors in VT */
  3782. /* (CWorkspace: 0) */
  3783. /* (RWorkspace: need BDSPAC) */
  3784. zbdsqr_("L", m, &ncvt, &nru, &c__0, &s[1], &rwork[ie], &vt[
  3785. vt_offset], ldvt, &u[u_offset], ldu, cdum, &c__1, &
  3786. rwork[irwork], info);
  3787. } else if (! wntuo && wntvo) {
  3788. /* Perform bidiagonal QR iteration, if desired, computing */
  3789. /* left singular vectors in U and computing right singular */
  3790. /* vectors in A */
  3791. /* (CWorkspace: 0) */
  3792. /* (RWorkspace: need BDSPAC) */
  3793. zbdsqr_("L", m, &ncvt, &nru, &c__0, &s[1], &rwork[ie], &a[
  3794. a_offset], lda, &u[u_offset], ldu, cdum, &c__1, &
  3795. rwork[irwork], info);
  3796. } else {
  3797. /* Perform bidiagonal QR iteration, if desired, computing */
  3798. /* left singular vectors in A and computing right singular */
  3799. /* vectors in VT */
  3800. /* (CWorkspace: 0) */
  3801. /* (RWorkspace: need BDSPAC) */
  3802. zbdsqr_("L", m, &ncvt, &nru, &c__0, &s[1], &rwork[ie], &vt[
  3803. vt_offset], ldvt, &a[a_offset], lda, cdum, &c__1, &
  3804. rwork[irwork], info);
  3805. }
  3806. }
  3807. }
  3808. /* Undo scaling if necessary */
  3809. if (iscl == 1) {
  3810. if (anrm > bignum) {
  3811. dlascl_("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &
  3812. minmn, &ierr);
  3813. }
  3814. if (*info != 0 && anrm > bignum) {
  3815. i__2 = minmn - 1;
  3816. dlascl_("G", &c__0, &c__0, &bignum, &anrm, &i__2, &c__1, &rwork[
  3817. ie], &minmn, &ierr);
  3818. }
  3819. if (anrm < smlnum) {
  3820. dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &
  3821. minmn, &ierr);
  3822. }
  3823. if (*info != 0 && anrm < smlnum) {
  3824. i__2 = minmn - 1;
  3825. dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &i__2, &c__1, &rwork[
  3826. ie], &minmn, &ierr);
  3827. }
  3828. }
  3829. /* Return optimal workspace in WORK(1) */
  3830. work[1].r = (doublereal) maxwrk, work[1].i = 0.;
  3831. return 0;
  3832. /* End of ZGESVD */
  3833. } /* zgesvd_ */