1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683 |
- fix compilation errors with GCC 10
- see https://github.com/Reference-ScaLAPACK/scalapack/pull/26 and https://github.com/Reference-ScaLAPACK/scalapack/issues/21
- From 9c909f06cf51a3d00252323ce52aba46cc64ab41 Mon Sep 17 00:00:00 2001
- From: =?UTF-8?q?Tiziano=20M=C3=BCller?= <tiziano.mueller@chem.uzh.ch>
- Date: Thu, 25 Jun 2020 18:36:46 +0200
- Subject: [PATCH 1/2] fix argument mismatches in the SRC
- ---
- SRC/pclarf.f | 80 +++++++++++++++++-----------------
- SRC/pclarfc.f | 88 ++++++++++++++++++-------------------
- SRC/pclarz.f | 111 ++++++++++++++++++++++++-----------------------
- SRC/pclarzc.f | 115 +++++++++++++++++++++++++------------------------
- SRC/pclattrs.f | 55 +++++++++++------------
- SRC/pclawil.f | 53 +++++++++++------------
- SRC/pctrevc.f | 20 +++++----
- SRC/pdhseqr.f | 36 ++++++++--------
- SRC/pdlacon.f | 36 ++++++++--------
- SRC/pdlarf.f | 80 +++++++++++++++++-----------------
- SRC/pdlarz.f | 100 +++++++++++++++++++++---------------------
- SRC/pdlawil.f | 48 ++++++++++-----------
- SRC/pdstebz.f | 20 ++++-----
- SRC/pdtrord.f | 43 +++++++++++-------
- SRC/pdtrsen.f | 24 ++++++-----
- SRC/pshseqr.f | 36 ++++++++--------
- SRC/pslacon.f | 36 +++++++++-------
- SRC/pslarf.f | 80 +++++++++++++++++-----------------
- SRC/pslarz.f | 100 +++++++++++++++++++++---------------------
- SRC/pslawil.f | 50 +++++++++++----------
- SRC/psstebz.f | 20 ++++-----
- SRC/pstrord.f | 45 +++++++++++--------
- SRC/pstrsen.f | 22 ++++++----
- SRC/pzlarf.f | 80 +++++++++++++++++-----------------
- SRC/pzlarfc.f | 88 ++++++++++++++++++-------------------
- SRC/pzlarz.f | 103 +++++++++++++++++++++----------------------
- SRC/pzlarzc.f | 111 ++++++++++++++++++++++++-----------------------
- SRC/pzlattrs.f | 55 +++++++++++------------
- SRC/pzlawil.f | 49 +++++++++++----------
- SRC/pztrevc.f | 20 +++++----
- 30 files changed, 927 insertions(+), 877 deletions(-)
- diff --git a/SRC/pclarf.f b/SRC/pclarf.f
- index f941e46..371f710 100644
- --- a/SRC/pclarf.f
- +++ b/SRC/pclarf.f
- @@ -242,7 +242,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
- $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
- $ NQ, RDEST
- - COMPLEX TAULOC
- + COMPLEX TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, CCOPY, CGEBR2D, CGEBS2D,
- @@ -336,7 +336,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -345,7 +345,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -363,8 +363,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -379,9 +379,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYCOL.EQ.ICCOL ) THEN
- *
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -398,7 +398,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL CGERC( MP, NQ, -TAULOC, V( IOFFV ), 1,
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
- $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -421,9 +421,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = MP+1
- CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -441,7 +441,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK, 1,
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -471,7 +471,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -480,7 +480,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -500,8 +500,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( IOFFC.GT.0 )
- - $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -516,18 +516,18 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( JJV )
- CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- IPW = MP+1
- CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -547,8 +547,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( IOFFC.GT.0 )
- - $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -577,9 +577,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYROW.EQ.ICROW ) THEN
- *
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -597,7 +597,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - w * v'
- *
- IF( IOFFV.GT.0 .AND. IOFFC.GT.0 )
- - $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1,
- + $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC ),
- $ LDC )
- END IF
- @@ -621,9 +621,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = NQ+1
- CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -641,8 +641,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -667,7 +667,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -676,7 +676,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -694,8 +694,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -720,18 +720,18 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( IIV )
- CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- IPW = NQ+1
- CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -750,8 +750,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - w * v'
- *
- IF( IOFFC.GT.0 )
- - $ CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -770,7 +770,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -779,7 +779,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -797,8 +797,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
- - $ C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pclarfc.f b/SRC/pclarfc.f
- index d6a2d3b..f84c493 100644
- --- a/SRC/pclarfc.f
- +++ b/SRC/pclarfc.f
- @@ -242,7 +242,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
- $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
- $ NQ, RDEST
- - COMPLEX TAULOC
- + COMPLEX TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, CCOPY, CGEBR2D, CGEBS2D,
- @@ -336,17 +336,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = CONJG( TAU( IIV ) )
- + TAULOC( 1 ) = CONJG( TAU( IIV ) )
- *
- ELSE
- *
- CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAULOC, 1, IVROW, MYCOL )
- - TAULOC = CONJG( TAULOC )
- + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -364,8 +364,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -380,9 +380,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYCOL.EQ.ICCOL ) THEN
- *
- - TAULOC = CONJG( TAU( JJV ) )
- + TAULOC( 1 ) = CONJG( TAU( JJV ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -399,7 +399,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL CGERC( MP, NQ, -TAULOC, V( IOFFV ), 1,
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
- $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -422,9 +422,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = MP+1
- CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = CONJG( WORK( IPW ) )
- + TAULOC( 1 ) = CONJG( WORK( IPW ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -442,7 +442,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK, 1,
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -472,17 +472,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = CONJG( TAU( IIV ) )
- + TAULOC( 1 ) = CONJG( TAU( IIV ) )
- *
- ELSE
- *
- CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
- $ 1, IVROW, MYCOL )
- - TAULOC = CONJG( TAULOC )
- + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -500,8 +500,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1,
- - $ C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -516,18 +516,18 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( JJV )
- CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = CONJG( TAU( JJV ) )
- + TAULOC( 1 ) = CONJG( TAU( JJV ) )
- *
- ELSE
- *
- IPW = MP+1
- CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = CONJG( WORK( IPW ) )
- + TAULOC( 1 ) = CONJG( WORK( IPW ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -545,8 +545,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1,
- - $ C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -575,9 +575,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYROW.EQ.ICROW ) THEN
- *
- - TAULOC = CONJG( TAU( IIV ) )
- + TAULOC( 1 ) = CONJG( TAU( IIV ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -594,7 +594,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK, 1,
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC ), LDC )
- END IF
- *
- @@ -617,9 +617,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = NQ+1
- CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = CONJG( WORK( IPW ) )
- + TAULOC( 1 ) = CONJG( WORK( IPW ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -637,8 +637,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -663,17 +663,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = CONJG( TAU( JJV ) )
- + TAULOC( 1 ) = CONJG( TAU( JJV ) )
- *
- ELSE
- *
- CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
- $ 1, MYROW, IVCOL )
- - TAULOC = CONJG( TAULOC )
- + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -691,8 +691,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -716,18 +716,18 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( IIV )
- CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = CONJG( TAU( IIV ) )
- + TAULOC( 1 ) = CONJG( TAU( IIV ) )
- *
- ELSE
- *
- IPW = NQ+1
- CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = CONJG( WORK( IPW ) )
- + TAULOC( 1 ) = CONJG( WORK( IPW ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -745,8 +745,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
- - $ C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -765,17 +765,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = CONJG( TAU( JJV ) )
- + TAULOC( 1 ) = CONJG( TAU( JJV ) )
- *
- ELSE
- *
- CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1,
- $ MYROW, IVCOL )
- - TAULOC = CONJG( TAULOC )
- + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -793,8 +793,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
- - $ C( IOFFC ), LDC )
- + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pclarz.f b/SRC/pclarz.f
- index 9ba730c..673860a 100644
- --- a/SRC/pclarz.f
- +++ b/SRC/pclarz.f
- @@ -251,7 +251,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
- $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
- $ NQC2, NQV, RDEST
- - COMPLEX TAULOC
- + COMPLEX TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, CAXPY, CCOPY, CGEBR2D,
- @@ -370,7 +370,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -379,7 +379,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -402,9 +402,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -420,9 +420,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYCOL.EQ.ICCOL2 ) THEN
- *
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -445,11 +445,11 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK,
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK,
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -471,9 +471,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = MPV+1
- CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -496,10 +496,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -530,16 +530,16 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- - CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
- - $ 1, IVROW, MYCOL )
- + CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
- + $ TAULOC( 1 ), 1, IVROW, MYCOL )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -562,10 +562,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -580,18 +580,18 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( JJV )
- CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- IPW = MPV+1
- CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -614,10 +614,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -646,9 +646,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYROW.EQ.ICROW2 ) THEN
- *
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -669,13 +669,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ ICCOL2 )
- *
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK, 1,
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- IF( MPC2.GT.0 .AND. NQV.GT.0 )
- - $ CALL CGERC( MPC2, NQV, -TAULOC, WORK, 1,
- + $ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC2 ),
- $ LDC )
- END IF
- @@ -699,9 +699,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = NQV+1
- CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -720,13 +720,14 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ),
- $ RDEST, ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- - $ C( IOFFC1 ), 1 )
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPC2, NQV, -TAULOC( 1 ),
- + $ WORK( IPW ), 1, WORK, 1,
- + $ C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -751,16 +752,16 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- - CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
- - $ 1, MYROW, IVCOL )
- + CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1,
- + $ TAULOC( 1 ), 1, MYROW, IVCOL )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -779,13 +780,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -809,18 +810,18 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( IIV )
- CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- IPW = NQV+1
- CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -840,13 +841,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -865,7 +866,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -874,7 +875,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -893,13 +894,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pclarzc.f b/SRC/pclarzc.f
- index f1bc21e..b6d3b6d 100644
- --- a/SRC/pclarzc.f
- +++ b/SRC/pclarzc.f
- @@ -251,7 +251,7 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
- $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
- $ NQC2, NQV, RDEST
- - COMPLEX TAULOC
- + COMPLEX TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, CAXPY, CCOPY, CGEBR2D,
- @@ -370,17 +370,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = CONJG( TAU( IIV ) )
- + TAULOC( 1 ) = CONJG( TAU( IIV ) )
- *
- ELSE
- *
- CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAULOC, 1, IVROW, MYCOL )
- - TAULOC = CONJG( TAULOC )
- + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -403,9 +403,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -421,9 +421,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYCOL.EQ.ICCOL2 ) THEN
- *
- - TAULOC = CONJG( TAU( JJV ) )
- + TAULOC( 1 ) = CONJG( TAU( JJV ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -446,11 +446,11 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK,
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK,
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -472,9 +472,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = MPV+1
- CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = CONJG( WORK( IPW ) )
- + TAULOC( 1 ) = CONJG( WORK( IPW ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -497,10 +497,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -531,17 +531,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = CONJG( TAU( IIV ) )
- + TAULOC( 1 ) = CONJG( TAU( IIV ) )
- *
- ELSE
- *
- CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
- $ 1, IVROW, MYCOL )
- - TAULOC = CONJG( TAULOC )
- + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -564,10 +564,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -582,18 +582,18 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( JJV )
- CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = CONJG( TAU( JJV ) )
- + TAULOC( 1 ) = CONJG( TAU( JJV ) )
- *
- ELSE
- *
- IPW = MPV+1
- CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = CONJG( WORK( IPW ) )
- + TAULOC( 1 ) = CONJG( WORK( IPW ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -616,10 +616,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -648,9 +648,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYROW.EQ.ICROW2 ) THEN
- *
- - TAULOC = CONJG( TAU( IIV ) )
- + TAULOC( 1 ) = CONJG( TAU( IIV ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -671,12 +671,12 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ ICCOL2 )
- *
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK, 1,
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MPC2, NQV, -TAULOC, WORK, 1,
- + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -699,9 +699,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = NQV+1
- CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = CONJG( WORK( IPW ) )
- + TAULOC( 1 ) = CONJG( WORK( IPW ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -720,13 +720,14 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ),
- $ RDEST, ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- - $ C( IOFFC1 ), 1 )
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPC2, NQV, -TAULOC( 1 ),
- + $ WORK( IPW ), 1, WORK, 1,
- + $ C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -751,17 +752,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = CONJG( TAU( JJV ) )
- + TAULOC( 1 ) = CONJG( TAU( JJV ) )
- *
- ELSE
- *
- CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
- $ 1, MYROW, IVCOL )
- - TAULOC = CONJG( TAULOC )
- + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -780,13 +781,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -810,18 +811,18 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( IIV )
- CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = CONJG( TAU( IIV ) )
- + TAULOC( 1 ) = CONJG( TAU( IIV ) )
- *
- ELSE
- *
- IPW = NQV+1
- CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = CONJG( WORK( IPW ) )
- + TAULOC( 1 ) = CONJG( WORK( IPW ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -841,13 +842,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -866,17 +867,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = CONJG( TAU( JJV ) )
- + TAULOC( 1 ) = CONJG( TAU( JJV ) )
- *
- ELSE
- *
- - CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1,
- - $ MYROW, IVCOL )
- - TAULOC = CONJG( TAULOC )
- + CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1,
- + $ TAULOC( 1 ), 1, MYROW, IVCOL )
- + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -895,13 +896,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pclattrs.f b/SRC/pclattrs.f
- index c744aea..0d12a8b 100644
- --- a/SRC/pclattrs.f
- +++ b/SRC/pclattrs.f
- @@ -271,7 +271,8 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- $ JINC, JLAST, LDA, LDX, MB, MYCOL, MYROW, NB,
- $ NPCOL, NPROW, RSRC
- REAL BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL,
- - $ XBND, XJ, XMAX
- + $ XBND, XJ
- + REAL XMAX( 1 )
- COMPLEX CSUMJ, TJJS, USCAL, XJTMP, ZDUM
- * ..
- * .. External Functions ..
- @@ -391,11 +392,11 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- * Compute a bound on the computed solution vector to see if the
- * Level 2 PBLAS routine PCTRSV can be used.
- *
- - XMAX = ZERO
- + XMAX( 1 ) = ZERO
- CALL PCAMAX( N, ZDUM, IMAX, X, IX, JX, DESCX, 1 )
- - XMAX = CABS2( ZDUM )
- + XMAX( 1 ) = CABS2( ZDUM )
- CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, -1, -1 )
- - XBND = XMAX
- + XBND = XMAX( 1 )
- *
- IF( NOTRAN ) THEN
- *
- @@ -590,16 +591,16 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- *
- * Use a Level 1 PBLAS solve, scaling intermediate results.
- *
- - IF( XMAX.GT.BIGNUM*HALF ) THEN
- + IF( XMAX( 1 ).GT.BIGNUM*HALF ) THEN
- *
- * Scale X so that its components are less than or equal to
- * BIGNUM in absolute value.
- *
- - SCALE = ( BIGNUM*HALF ) / XMAX
- + SCALE = ( BIGNUM*HALF ) / XMAX( 1 )
- CALL PCSSCAL( N, SCALE, X, IX, JX, DESCX, 1 )
- - XMAX = BIGNUM
- + XMAX( 1 ) = BIGNUM
- ELSE
- - XMAX = XMAX*TWO
- + XMAX( 1 ) = XMAX( 1 )*TWO
- END IF
- *
- IF( NOTRAN ) THEN
- @@ -651,7 +652,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- * X( J ) = CLADIV( X( J ), TJJS )
- @@ -682,7 +683,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- * X( J ) = CLADIV( X( J ), TJJS )
- * XJ = CABS1( X( J ) )
- @@ -706,7 +707,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- XJTMP = CONE
- XJ = ONE
- SCALE = ZERO
- - XMAX = ZERO
- + XMAX( 1 ) = ZERO
- END IF
- 90 CONTINUE
- *
- @@ -715,7 +716,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- *
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- - IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
- + IF( CNORM( J ).GT.( BIGNUM-XMAX( 1 ) )*REC ) THEN
- *
- * Scale x by 1/(2*abs(x(j))).
- *
- @@ -724,7 +725,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- END IF
- - ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
- + ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX( 1 ) ) ) THEN
- *
- * Scale x by 1/2.
- *
- @@ -743,7 +744,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCAXPY( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1, X,
- $ IX, JX, DESCX, 1 )
- CALL PCAMAX( J-1, ZDUM, IMAX, X, IX, JX, DESCX, 1 )
- - XMAX = CABS1( ZDUM )
- + XMAX( 1 ) = CABS1( ZDUM )
- CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1,
- $ -1, -1 )
- END IF
- @@ -757,7 +758,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCAXPY( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1,
- $ X, IX+J, JX, DESCX, 1 )
- CALL PCAMAX( N-J, ZDUM, I, X, IX+J, JX, DESCX, 1 )
- - XMAX = CABS1( ZDUM )
- + XMAX( 1 ) = CABS1( ZDUM )
- CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1,
- $ -1, -1 )
- END IF
- @@ -785,7 +786,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- END IF
- XJ = CABS1( XJTMP )
- USCAL = CMPLX( TSCAL )
- - REC = ONE / MAX( XMAX, ONE )
- + REC = ONE / MAX( XMAX( 1 ), ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
- *
- * If x(j) could overflow, scale x by 1/(2*XMAX).
- @@ -820,7 +821,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- *
- @@ -924,7 +925,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- * X( J ) = CLADIV( X( J ), TJJS )
- @@ -945,7 +946,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- * X( J ) = CLADIV( X( J ), TJJS )
- XJTMP = CLADIV( XJTMP, TJJS )
- @@ -966,7 +967,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- END IF
- XJTMP = CONE
- SCALE = ZERO
- - XMAX = ZERO
- + XMAX( 1 ) = ZERO
- END IF
- 110 CONTINUE
- ELSE
- @@ -981,7 +982,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- X( IROWX ) = XJTMP
- END IF
- END IF
- - XMAX = MAX( XMAX, CABS1( XJTMP ) )
- + XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) )
- 120 CONTINUE
- *
- ELSE
- @@ -1004,7 +1005,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- END IF
- XJ = CABS1( XJTMP )
- USCAL = TSCAL
- - REC = ONE / MAX( XMAX, ONE )
- + REC = ONE / MAX( XMAX( 1 ), ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
- *
- * If x(j) could overflow, scale x by 1/(2*XMAX).
- @@ -1039,7 +1040,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- *
- @@ -1145,7 +1146,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- * X( J ) = CLADIV( X( J ), TJJS )
- @@ -1164,7 +1165,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- * X( J ) = CLADIV( X( J ), TJJS )
- XJTMP = CLADIV( XJTMP, TJJS )
- @@ -1181,7 +1182,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- $ X( IROWX ) = CONE
- XJTMP = CONE
- SCALE = ZERO
- - XMAX = ZERO
- + XMAX( 1 ) = ZERO
- END IF
- 130 CONTINUE
- ELSE
- @@ -1194,7 +1195,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
- $ X( IROWX ) = XJTMP
- END IF
- - XMAX = MAX( XMAX, CABS1( XJTMP ) )
- + XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) )
- 140 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- diff --git a/SRC/pclawil.f b/SRC/pclawil.f
- index 24a49b9..b33b3b1 100644
- --- a/SRC/pclawil.f
- +++ b/SRC/pclawil.f
- @@ -124,11 +124,10 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT,
- $ RSRC, UP
- REAL S
- - COMPLEX CDUM, H11, H12, H21, H22, H33S, H44S, V1, V2,
- - $ V3
- + COMPLEX CDUM, H22, H33S, H44S, V1, V2
- * ..
- * .. Local Arrays ..
- - COMPLEX BUF( 4 )
- + COMPLEX BUF( 4 ), V3( 1 ), H11( 1 ), H12( 1 ), H21( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, INFOG2L, CGERV2D, CGESD2D
- @@ -181,18 +180,18 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( NPCOL.GT.1 ) THEN
- CALL CGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT )
- ELSE
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- IF( NUM.GT.1 ) THEN
- CALL CGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT )
- - H11 = BUF( 1 )
- - H21 = BUF( 2 )
- - H12 = BUF( 3 )
- + H11( 1 ) = BUF( 1 )
- + H21( 1 ) = BUF( 2 )
- + H12( 1 ) = BUF( 3 )
- H22 = BUF( 4 )
- ELSE
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- END IF
- END IF
- @@ -223,22 +222,22 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
- $ IROW, ICOL, RSRC, JSRC )
- IF( NUM.GT.1 ) THEN
- - CALL CGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT )
- + CALL CGERV2D( CONTXT, 1, 1, H11( 1 ), 1, UP, LEFT )
- ELSE
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- END IF
- IF( NPROW.GT.1 ) THEN
- CALL CGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL )
- ELSE
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- END IF
- IF( NPCOL.GT.1 ) THEN
- - CALL CGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT )
- + CALL CGERV2D( CONTXT, 1, 1, H21( 1 ), 1, MYROW, LEFT )
- ELSE
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- END IF
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- END IF
- IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) )
- @@ -247,24 +246,24 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( MODKM1.GT.1 ) THEN
- CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
- $ IROW, ICOL, RSRC, JSRC )
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- *
- - H44S = H44 - H11
- - H33S = H33 - H11
- - V1 = ( H33S*H44S-H43H34 ) / H21 + H12
- - V2 = H22 - H11 - H33S - H44S
- - S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3 )
- + H44S = H44 - H11( 1 )
- + H33S = H33 - H11( 1 )
- + V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 )
- + V2 = H22 - H11( 1 ) - H33S - H44S
- + S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3( 1 ) )
- V1 = V1 / S
- V2 = V2 / S
- - V3 = V3 / S
- + V3( 1 ) = V3( 1 ) / S
- V( 1 ) = V1
- V( 2 ) = V2
- - V( 3 ) = V3
- + V( 3 ) = V3( 1 )
- *
- RETURN
- *
- diff --git a/SRC/pctrevc.f b/SRC/pctrevc.f
- index d0a3043..bf6c52b 100644
- --- a/SRC/pctrevc.f
- +++ b/SRC/pctrevc.f
- @@ -218,11 +218,12 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- $ ITMP2, J, K, KI, LDT, LDVL, LDVR, LDW, MB,
- $ MYCOL, MYROW, NB, NPCOL, NPROW, RSRC
- REAL SELF
- - REAL OVFL, REMAXD, SCALE, SMIN, SMLNUM, ULP, UNFL
- + REAL OVFL, REMAXD, SCALE, SMLNUM, ULP, UNFL
- COMPLEX CDUM, REMAXC, SHIFT
- * ..
- * .. Local Arrays ..
- INTEGER DESCW( DLEN_ )
- + REAL SMIN( 1 )
- * ..
- * .. External Functions ..
- LOGICAL LSAME
- @@ -355,13 +356,13 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- $ GO TO 70
- END IF
- *
- - SMIN = ZERO
- + SMIN( 1 ) = ZERO
- SHIFT = CZERO
- CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL,
- $ IROW, ICOL, ITMP1, ITMP2 )
- IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
- SHIFT = T( ( ICOL-1 )*LDT+IROW )
- - SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
- + SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
- END IF
- CALL SGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 )
- CALL CGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 )
- @@ -396,8 +397,9 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
- T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -
- $ SHIFT
- - IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) THEN
- - T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN )
- + IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) )
- + $ THEN
- + T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN( 1 ) )
- END IF
- END IF
- 50 CONTINUE
- @@ -467,13 +469,13 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- $ GO TO 110
- END IF
- *
- - SMIN = ZERO
- + SMIN( 1 ) = ZERO
- SHIFT = CZERO
- CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL,
- $ IROW, ICOL, ITMP1, ITMP2 )
- IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
- SHIFT = T( ( ICOL-1 )*LDT+IROW )
- - SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
- + SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
- END IF
- CALL SGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 )
- CALL CGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 )
- @@ -507,8 +509,8 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
- T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -
- $ SHIFT
- - IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN )
- - $ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN )
- + IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) )
- + $ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN( 1 ) )
- END IF
- 90 CONTINUE
- *
- diff --git a/SRC/pdhseqr.f b/SRC/pdhseqr.f
- index ffc3652..6e0f751 100644
- --- a/SRC/pdhseqr.f
- +++ b/SRC/pdhseqr.f
- @@ -259,11 +259,12 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
- $ HRSRC4, HCSRC4, LIWKOPT
- LOGICAL INITZ, LQUERY, WANTT, WANTZ, PAIR, BORDER
- DOUBLE PRECISION TMP1, TMP2, TMP3, TMP4, DUM1, DUM2, DUM3,
- - $ DUM4, ELEM1, ELEM2, ELEM3, ELEM4,
- + $ DUM4, ELEM1, ELEM4,
- $ CS, SN, ELEM5, TMP, LWKOPT
- * ..
- * .. Local Arrays ..
- INTEGER DESCH2( DLEN_ )
- + DOUBLE PRECISION ELEM2( 1 ), ELEM3( 1 )
- * ..
- * .. External Functions ..
- INTEGER PILAENVX, NUMROC, ICEIL
- @@ -566,28 +567,28 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
- IF( MYROW.EQ.HRSRC1 .AND. MYCOL.EQ.HCSRC1 ) THEN
- ELEM1 = H((JLOC1-1)*LLDH+ILOC1)
- IF( K.LT.N ) THEN
- - ELEM3 = H((JLOC1-1)*LLDH+ILOC1+1)
- + ELEM3( 1 ) = H((JLOC1-1)*LLDH+ILOC1+1)
- ELSE
- - ELEM3 = ZERO
- + ELEM3( 1 ) = ZERO
- END IF
- - IF( ELEM3.NE.ZERO ) THEN
- - ELEM2 = H((JLOC1)*LLDH+ILOC1)
- + IF( ELEM3( 1 ).NE.ZERO ) THEN
- + ELEM2( 1 ) = H((JLOC1)*LLDH+ILOC1)
- ELEM4 = H((JLOC1)*LLDH+ILOC1+1)
- - CALL DLANV2( ELEM1, ELEM2, ELEM3, ELEM4,
- - $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ),
- - $ SN, CS )
- + CALL DLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ),
- + $ ELEM4, WR( K ), WI( K ), WR( K+1 ),
- + $ WI( K+1 ), SN, CS )
- PAIR = .TRUE.
- ELSE
- IF( K.GT.1 ) THEN
- TMP = H((JLOC1-2)*LLDH+ILOC1)
- IF( TMP.NE.ZERO ) THEN
- ELEM1 = H((JLOC1-2)*LLDH+ILOC1-1)
- - ELEM2 = H((JLOC1-1)*LLDH+ILOC1-1)
- - ELEM3 = H((JLOC1-2)*LLDH+ILOC1)
- + ELEM2( 1 ) = H((JLOC1-1)*LLDH+ILOC1-1)
- + ELEM3( 1 ) = H((JLOC1-2)*LLDH+ILOC1)
- ELEM4 = H((JLOC1-1)*LLDH+ILOC1)
- - CALL DLANV2( ELEM1, ELEM2, ELEM3,
- - $ ELEM4, WR( K-1 ), WI( K-1 ),
- - $ WR( K ), WI( K ), SN, CS )
- + CALL DLANV2( ELEM1, ELEM2( 1 ),
- + $ ELEM3( 1 ), ELEM4, WR( K-1 ),
- + $ WI( K-1 ), WR( K ), WI( K ), SN, CS )
- ELSE
- WR( K ) = ELEM1
- END IF
- @@ -620,12 +621,12 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
- CALL INFOG2L( K+1, K+1, DESCH, NPROW, NPCOL, MYROW, MYCOL,
- $ ILOC4, JLOC4, HRSRC4, HCSRC4 )
- IF( MYROW.EQ.HRSRC2 .AND. MYCOL.EQ.HCSRC2 ) THEN
- - ELEM2 = H((JLOC2-1)*LLDH+ILOC2)
- + ELEM2( 1 ) = H((JLOC2-1)*LLDH+ILOC2)
- IF( HRSRC1.NE.HRSRC2 .OR. HCSRC1.NE.HCSRC2 )
- $ CALL DGESD2D( ICTXT, 1, 1, ELEM2, 1, HRSRC1, HCSRC1)
- END IF
- IF( MYROW.EQ.HRSRC3 .AND. MYCOL.EQ.HCSRC3 ) THEN
- - ELEM3 = H((JLOC3-1)*LLDH+ILOC3)
- + ELEM3( 1 ) = H((JLOC3-1)*LLDH+ILOC3)
- IF( HRSRC1.NE.HRSRC3 .OR. HCSRC1.NE.HCSRC3 )
- $ CALL DGESD2D( ICTXT, 1, 1, ELEM3, 1, HRSRC1, HCSRC1)
- END IF
- @@ -651,8 +652,9 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
- ELEM5 = WORK(2)
- IF( ELEM5.EQ.ZERO ) THEN
- IF( WR( K ).EQ.ZERO .AND. WI( K ).EQ.ZERO ) THEN
- - CALL DLANV2( ELEM1, ELEM2, ELEM3, ELEM4, WR( K ),
- - $ WI( K ), WR( K+1 ), WI( K+1 ), SN, CS )
- + CALL DLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ELEM4,
- + $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), SN,
- + $ CS )
- ELSEIF( WR( K+1 ).EQ.ZERO .AND. WI( K+1 ).EQ.ZERO )
- $ THEN
- WR( K+1 ) = ELEM4
- diff --git a/SRC/pdlacon.f b/SRC/pdlacon.f
- index b625d97..74b9eab 100644
- --- a/SRC/pdlacon.f
- +++ b/SRC/pdlacon.f
- @@ -160,10 +160,10 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- INTEGER I, ICTXT, IFLAG, IIVX, IMAXROW, IOFFVX, IROFF,
- $ ITER, IVXCOL, IVXROW, J, JLAST, JJVX, JUMP,
- $ K, MYCOL, MYROW, NP, NPCOL, NPROW
- - DOUBLE PRECISION ALTSGN, ESTOLD, JLMAX, TEMP, XMAX
- + DOUBLE PRECISION ALTSGN, ESTOLD, JLMAX, XMAX
- * ..
- * .. Local Arrays ..
- - DOUBLE PRECISION WORK( 2 )
- + DOUBLE PRECISION ESTWORK( 1 ), TEMP( 1 ), WORK( 2 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, DCOPY, DGEBR2D, DGEBS2D,
- @@ -184,6 +184,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- *
- * Get grid parameters.
- *
- + ESTWORK( 1 ) = EST
- ICTXT = DESCX( CTXT_ )
- CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
- *
- @@ -215,21 +216,21 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- IF( N.EQ.1 ) THEN
- IF( MYROW.EQ.IVXROW ) THEN
- V( IOFFVX ) = X( IOFFVX )
- - EST = ABS( V( IOFFVX ) )
- - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
- + ESTWORK( 1 ) = ABS( V( IOFFVX ) )
- + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
- ELSE
- - CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
- + CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
- $ IVXROW, MYCOL )
- END IF
- * ... QUIT
- GO TO 150
- END IF
- - CALL PDASUM( N, EST, X, IX, JX, DESCX, 1 )
- + CALL PDASUM( N, ESTWORK( 1 ), X, IX, JX, DESCX, 1 )
- IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
- IF( MYROW.EQ.IVXROW ) THEN
- - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
- + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
- ELSE
- - CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
- + CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
- $ IVXROW, MYCOL )
- END IF
- END IF
- @@ -281,13 +282,13 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- *
- 70 CONTINUE
- CALL DCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 )
- - ESTOLD = EST
- - CALL PDASUM( N, EST, V, IV, JV, DESCV, 1 )
- + ESTOLD = ESTWORK( 1 )
- + CALL PDASUM( N, ESTWORK( 1 ), V, IV, JV, DESCV, 1 )
- IF( DESCV( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
- IF( MYROW.EQ.IVXROW ) THEN
- - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
- + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
- ELSE
- - CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
- + CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
- $ IVXROW, MYCOL )
- END IF
- END IF
- @@ -305,7 +306,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
- * ALONG WITH IT, TEST FOR CYCLING.
- *
- - IF( IFLAG.EQ.0 .OR. EST.LE.ESTOLD )
- + IF( IFLAG.EQ.0 .OR. ESTWORK( 1 ).LE.ESTOLD )
- $ GO TO 120
- *
- DO 100 I = IOFFVX, IOFFVX+NP-1
- @@ -361,7 +362,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- * X HAS BEEN OVERWRITTEN BY A*X
- *
- 140 CONTINUE
- - CALL PDASUM( N, TEMP, X, IX, JX, DESCX, 1 )
- + CALL PDASUM( N, TEMP( 1 ), X, IX, JX, DESCX, 1 )
- IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
- IF( MYROW.EQ.IVXROW ) THEN
- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, TEMP, 1 )
- @@ -370,15 +371,16 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- $ IVXROW, MYCOL )
- END IF
- END IF
- - TEMP = TWO*( TEMP / DBLE( 3*N ) )
- - IF( TEMP.GT.EST ) THEN
- + TEMP( 1 ) = TWO*( TEMP( 1 ) / DBLE( 3*N ) )
- + IF( TEMP( 1 ).GT.ESTWORK( 1 ) ) THEN
- CALL DCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 )
- - EST = TEMP
- + ESTWORK( 1 ) = TEMP( 1 )
- END IF
- *
- 150 CONTINUE
- KASE = 0
- *
- + EST = ESTWORK( 1 )
- RETURN
- *
- * End of PDLACON
- diff --git a/SRC/pdlarf.f b/SRC/pdlarf.f
- index 29da1ac..41368d6 100644
- --- a/SRC/pdlarf.f
- +++ b/SRC/pdlarf.f
- @@ -241,7 +241,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
- $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
- $ NQ, RDEST
- - DOUBLE PRECISION TAULOC
- + DOUBLE PRECISION TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, DCOPY, DGEBR2D, DGEBS2D,
- @@ -335,7 +335,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -344,7 +344,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -362,8 +362,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -378,9 +378,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYCOL.EQ.ICCOL ) THEN
- *
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -397,8 +397,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL DGER( MP, NQ, -TAULOC, V( IOFFV ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + CALL DGER( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -420,9 +420,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = MP+1
- CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -440,7 +440,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL DGER( MP, NQ, -TAULOC, WORK, 1,
- + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -470,7 +470,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -479,7 +479,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -499,8 +499,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( IOFFC.GT.0 )
- - $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -515,18 +515,18 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( JJV )
- CALL DGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- IPW = MP+1
- CALL DGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -546,8 +546,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( IOFFC.GT.0 )
- - $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -576,9 +576,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYROW.EQ.ICROW ) THEN
- *
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -596,7 +596,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - w * v'
- *
- IF( IOFFV.GT.0 .AND. IOFFC.GT.0 )
- - $ CALL DGER( MP, NQ, -TAULOC, WORK, 1,
- + $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC ), LDC )
- END IF
- *
- @@ -619,9 +619,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = NQ+1
- CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -639,7 +639,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1,
- + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -665,7 +665,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -674,7 +674,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -692,8 +692,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -718,18 +718,18 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( IIV )
- CALL DGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- IPW = NQ+1
- CALL DGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -748,8 +748,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - w * v'
- *
- IF( IOFFC.GT.0 )
- - $ CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -768,7 +768,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -777,7 +777,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -795,8 +795,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
- - $ C( IOFFC ), LDC )
- + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, WORK,
- + $ 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pdlarz.f b/SRC/pdlarz.f
- index b91282c..f45c137 100644
- --- a/SRC/pdlarz.f
- +++ b/SRC/pdlarz.f
- @@ -250,7 +250,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
- $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
- $ NQC2, NQV, RDEST
- - DOUBLE PRECISION TAULOC
- + DOUBLE PRECISION TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, DAXPY, DCOPY, DGEBR2D,
- @@ -369,7 +369,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -378,7 +378,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -401,9 +401,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL DGER( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -419,9 +419,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYCOL.EQ.ICCOL2 ) THEN
- *
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -444,11 +444,11 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL DAXPY( NQC2, -TAULOC, WORK,
- + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK,
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL DGER( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL DGER( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -470,9 +470,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = MPV+1
- CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -495,10 +495,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL DGER( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -529,7 +529,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -538,7 +538,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -561,10 +561,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -579,18 +579,18 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( JJV )
- CALL DGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- IPW = MPV+1
- CALL DGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -613,10 +613,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -645,9 +645,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYROW.EQ.ICROW2 ) THEN
- *
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -668,13 +668,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ ICCOL2 )
- *
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL DAXPY( MPC2, -TAULOC, WORK, 1,
- + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- IF( MPC2.GT.0 .AND. NQV.GT.0 )
- - $ CALL DGER( MPC2, NQV, -TAULOC, WORK, 1,
- + $ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC2 ),
- $ LDC )
- END IF
- @@ -698,9 +698,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = NQV+1
- CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -719,13 +719,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ),
- $ RDEST, ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- - $ C( IOFFC1 ), 1 )
- + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -750,7 +750,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -759,7 +759,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -778,12 +778,12 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- + CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -808,18 +808,18 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( IIV )
- CALL DGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- IPW = NQV+1
- CALL DGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -839,13 +839,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -864,7 +864,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -873,7 +873,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -892,13 +892,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pdlawil.f b/SRC/pdlawil.f
- index 90a4d74..e8bc3a0 100644
- --- a/SRC/pdlawil.f
- +++ b/SRC/pdlawil.f
- @@ -120,10 +120,10 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- INTEGER CONTXT, DOWN, HBL, ICOL, IROW, JSRC, LDA, LEFT,
- $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT,
- $ RSRC, UP
- - DOUBLE PRECISION H11, H12, H21, H22, H33S, H44S, S, V1, V2, V3
- + DOUBLE PRECISION H22, H33S, H44S, S, V1, V2
- * ..
- * .. Local Arrays ..
- - DOUBLE PRECISION BUF( 4 )
- + DOUBLE PRECISION BUF( 4 ), H11( 1 ), H12( 1 ), H21( 1 ), V3( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, DGERV2D, DGESD2D, INFOG2L
- @@ -170,18 +170,18 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( NPCOL.GT.1 ) THEN
- CALL DGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT )
- ELSE
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- IF( NUM.GT.1 ) THEN
- CALL DGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT )
- - H11 = BUF( 1 )
- - H21 = BUF( 2 )
- - H12 = BUF( 3 )
- + H11( 1 ) = BUF( 1 )
- + H21( 1 ) = BUF( 2 )
- + H12( 1 ) = BUF( 3 )
- H22 = BUF( 4 )
- ELSE
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- END IF
- END IF
- @@ -214,20 +214,20 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( NUM.GT.1 ) THEN
- CALL DGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT )
- ELSE
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- END IF
- IF( NPROW.GT.1 ) THEN
- CALL DGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL )
- ELSE
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- END IF
- IF( NPCOL.GT.1 ) THEN
- CALL DGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT )
- ELSE
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- END IF
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- END IF
- IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) )
- @@ -236,24 +236,24 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( MODKM1.GT.1 ) THEN
- CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
- $ IROW, ICOL, RSRC, JSRC )
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- *
- - H44S = H44 - H11
- - H33S = H33 - H11
- - V1 = ( H33S*H44S-H43H34 ) / H21 + H12
- - V2 = H22 - H11 - H33S - H44S
- - S = ABS( V1 ) + ABS( V2 ) + ABS( V3 )
- + H44S = H44 - H11( 1 )
- + H33S = H33 - H11( 1 )
- + V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 )
- + V2 = H22 - H11( 1 ) - H33S - H44S
- + S = ABS( V1 ) + ABS( V2 ) + ABS( V3( 1 ) )
- V1 = V1 / S
- V2 = V2 / S
- - V3 = V3 / S
- + V3( 1 ) = V3( 1 ) / S
- V( 1 ) = V1
- V( 2 ) = V2
- - V( 3 ) = V3
- + V( 3 ) = V3( 1 )
- *
- RETURN
- *
- diff --git a/SRC/pdstebz.f b/SRC/pdstebz.f
- index e7006f9..bf4dacc 100644
- --- a/SRC/pdstebz.f
- +++ b/SRC/pdstebz.f
- @@ -246,14 +246,14 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU,
- $ ITMP2, J, JB, K, LAST, LEXTRA, LREQ, MYCOL,
- $ MYROW, NALPHA, NBETA, NCMP, NEIGINT, NEXT, NGL,
- $ NGLOB, NGU, NINT, NPCOL, NPROW, OFFSET,
- - $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF,
- - $ TORECV
- + $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF
- DOUBLE PRECISION ALPHA, ATOLI, BETA, BNORM, DRECV, DSEND, GL,
- $ GU, INITVL, INITVU, LSAVE, MID, PIVMIN, RELTOL,
- $ SAFEMN, TMP1, TMP2, TNORM, ULP
- * ..
- * .. Local Arrays ..
- INTEGER IDUM( 5, 2 )
- + INTEGER TORECV( 1, 1 )
- * ..
- * .. Executable Statements ..
- * This is just to keep ftnchek happy
- @@ -784,14 +784,14 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU,
- ELSE
- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', 1, 1, TORECV, 1, 0,
- $ I-1 )
- - IF( TORECV.NE.0 ) THEN
- - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, IWORK,
- - $ TORECV, 0, I-1 )
- - CALL DGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, WORK,
- - $ TORECV, 0, I-1 )
- - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1,
- - $ IWORK( N+1 ), TORECV, 0, I-1 )
- - DO 120 J = 1, TORECV
- + IF( TORECV( 1, 1 ).NE.0 ) THEN
- + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
- + $ IWORK, TORECV( 1, 1 ), 0, I-1 )
- + CALL DGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
- + $ WORK, TORECV( 1, 1 ), 0, I-1 )
- + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
- + $ IWORK( N+1 ), TORECV( 1, 1 ), 0, I-1 )
- + DO 120 J = 1, TORECV( 1, 1 )
- W( IWORK( J ) ) = WORK( J )
- IBLOCK( IWORK( J ) ) = IWORK( N+J )
- 120 CONTINUE
- diff --git a/SRC/pdtrord.f b/SRC/pdtrord.f
- index 1f37d8e..3870574 100644
- --- a/SRC/pdtrord.f
- +++ b/SRC/pdtrord.f
- @@ -328,12 +328,13 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- $ EAST, WEST, ILOC4, SOUTH, NORTH, INDXS,
- $ ITT, JTT, ILEN, DLEN, INDXE, TRSRC1, TCSRC1,
- $ TRSRC2, TCSRC2, ILOS, DIR, TLIHI, TLILO, TLSEL,
- - $ ROUND, LAST, WIN0S, WIN0E, WINE, MMAX, MMIN
- + $ ROUND, LAST, WIN0S, WIN0E, WINE
- DOUBLE PRECISION ELEM, ELEM1, ELEM2, ELEM3, ELEM4, SN, CS, TMP,
- $ ELEM5
- * ..
- * .. Local Arrays ..
- - INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 )
- + INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ), MMAX( 1 ),
- + $ MMIN( 1 ), INFODUM( 1 )
- * ..
- * .. External Functions ..
- LOGICAL LSAME
- @@ -483,16 +484,16 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- END IF
- IF( SELECT(K).NE.0 ) M = M + 1
- 10 CONTINUE
- - MMAX = M
- - MMIN = M
- + MMAX( 1 ) = M
- + MMIN( 1 ) = M
- IF( NPROCS.GT.1 )
- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1,
- $ -1, -1, -1, -1 )
- IF( NPROCS.GT.1 )
- $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1,
- $ -1, -1, -1, -1 )
- - IF( MMAX.GT.MMIN ) THEN
- - M = MMAX
- + IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN
- + M = MMAX( 1 )
- IF( NPROCS.GT.1 )
- $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, SELECT, N,
- $ -1, -1, -1, -1, -1 )
- @@ -520,9 +521,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- *
- * Global maximum on info.
- *
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, -1,
- $ -1, -1 )
- + INFO = INFODUM( 1 )
- + END IF
- *
- * Return if some argument is incorrect.
- *
- @@ -1576,9 +1579,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- * experienced a failure in the reordering.
- *
- MYIERR = IERR
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
- $ -1, -1, -1, -1 )
- + IERR = INFODUM( 1 )
- + END IF
- *
- IF( IERR.NE.0 ) THEN
- *
- @@ -1586,9 +1591,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- * to swap.
- *
- IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1)
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
- $ -1, -1, -1, -1 )
- + INFO = INFODUM( 1 )
- + END IF
- GO TO 300
- END IF
- *
- @@ -3245,9 +3252,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- * experienced a failure in the reordering.
- *
- MYIERR = IERR
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
- $ -1, -1, -1, -1 )
- + IERR = INFODUM( 1 )
- + END IF
- *
- IF( IERR.NE.0 ) THEN
- *
- @@ -3255,9 +3264,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- * to swap.
- *
- IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1)
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
- $ -1, -1, -1, -1 )
- + IERR = INFODUM( 1 )
- + END IF
- GO TO 300
- END IF
- *
- diff --git a/SRC/pdtrsen.f b/SRC/pdtrsen.f
- index 78c5599..c65ea91 100644
- --- a/SRC/pdtrsen.f
- +++ b/SRC/pdtrsen.f
- @@ -354,13 +354,15 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
- LOGICAL LQUERY, WANTBH, WANTQ, WANTS, WANTSP
- INTEGER ICOFFT12, ICTXT, IDUM1, IDUM2, IERR, ILOC1,
- $ IPW1, ITER, ITT, JLOC1, JTT, K, LIWMIN, LLDT,
- - $ LLDQ, LWMIN, MMAX, MMIN, MYROW, MYCOL, N1, N2,
- + $ LLDQ, LWMIN, MYROW, MYCOL, N1, N2,
- $ NB, NOEXSY, NPCOL, NPROCS, NPROW, SPACE,
- $ T12ROWS, T12COLS, TCOLS, TCSRC, TROWS, TRSRC,
- $ WRK1, IWRK1, WRK2, IWRK2, WRK3, IWRK3
- - DOUBLE PRECISION DPDUM1, ELEM, EST, SCALE, RNORM
- + DOUBLE PRECISION ELEM, EST, SCALE, RNORM
- * .. Local Arrays ..
- - INTEGER DESCT12( DLEN_ ), MBNB2( 2 )
- + INTEGER DESCT12( DLEN_ ), MBNB2( 2 ), MMAX( 1 ),
- + $ MMIN( 1 )
- + DOUBLE PRECISION DPDUM1( 1 )
- * ..
- * .. External Functions ..
- LOGICAL LSAME
- @@ -521,16 +523,16 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
- END IF
- IF( SELECT(K) ) M = M + 1
- 10 CONTINUE
- - MMAX = M
- - MMIN = M
- + MMAX( 1 ) = M
- + MMIN( 1 ) = M
- IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1,
- - $ -1, -1, -1, -1 )
- + $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX( 1 ), 1,
- + $ -1, -1, -1, -1, -1 )
- IF( NPROCS.GT.1 )
- - $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1,
- - $ -1, -1, -1, -1 )
- - IF( MMAX.GT.MMIN ) THEN
- - M = MMAX
- + $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN( 1 ), 1,
- + $ -1, -1, -1, -1, -1 )
- + IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN
- + M = MMAX( 1 )
- IF( NPROCS.GT.1 )
- $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, IWORK, N,
- $ -1, -1, -1, -1, -1 )
- diff --git a/SRC/pshseqr.f b/SRC/pshseqr.f
- index 10eb24a..e8ecea9 100644
- --- a/SRC/pshseqr.f
- +++ b/SRC/pshseqr.f
- @@ -259,11 +259,12 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
- $ HRSRC4, HCSRC4, LIWKOPT
- LOGICAL INITZ, LQUERY, WANTT, WANTZ, PAIR, BORDER
- REAL TMP1, TMP2, TMP3, TMP4, DUM1, DUM2, DUM3,
- - $ DUM4, ELEM1, ELEM2, ELEM3, ELEM4,
- + $ DUM4, ELEM1, ELEM4,
- $ CS, SN, ELEM5, TMP, LWKOPT
- * ..
- * .. Local Arrays ..
- INTEGER DESCH2( DLEN_ )
- + REAL ELEM2( 1 ), ELEM3( 1 )
- * ..
- * .. External Functions ..
- INTEGER PILAENVX, NUMROC, ICEIL
- @@ -566,28 +567,28 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
- IF( MYROW.EQ.HRSRC1 .AND. MYCOL.EQ.HCSRC1 ) THEN
- ELEM1 = H((JLOC1-1)*LLDH+ILOC1)
- IF( K.LT.N ) THEN
- - ELEM3 = H((JLOC1-1)*LLDH+ILOC1+1)
- + ELEM3( 1 ) = H((JLOC1-1)*LLDH+ILOC1+1)
- ELSE
- - ELEM3 = ZERO
- + ELEM3( 1 ) = ZERO
- END IF
- - IF( ELEM3.NE.ZERO ) THEN
- - ELEM2 = H((JLOC1)*LLDH+ILOC1)
- + IF( ELEM3( 1 ).NE.ZERO ) THEN
- + ELEM2( 1 ) = H((JLOC1)*LLDH+ILOC1)
- ELEM4 = H((JLOC1)*LLDH+ILOC1+1)
- - CALL SLANV2( ELEM1, ELEM2, ELEM3, ELEM4,
- - $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ),
- - $ SN, CS )
- + CALL SLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ),
- + $ ELEM4, WR( K ), WI( K ), WR( K+1 ),
- + $ WI( K+1 ), SN, CS )
- PAIR = .TRUE.
- ELSE
- IF( K.GT.1 ) THEN
- TMP = H((JLOC1-2)*LLDH+ILOC1)
- IF( TMP.NE.ZERO ) THEN
- ELEM1 = H((JLOC1-2)*LLDH+ILOC1-1)
- - ELEM2 = H((JLOC1-1)*LLDH+ILOC1-1)
- - ELEM3 = H((JLOC1-2)*LLDH+ILOC1)
- + ELEM2( 1 ) = H((JLOC1-1)*LLDH+ILOC1-1)
- + ELEM3( 1 ) = H((JLOC1-2)*LLDH+ILOC1)
- ELEM4 = H((JLOC1-1)*LLDH+ILOC1)
- - CALL SLANV2( ELEM1, ELEM2, ELEM3,
- - $ ELEM4, WR( K-1 ), WI( K-1 ),
- - $ WR( K ), WI( K ), SN, CS )
- + CALL SLANV2( ELEM1, ELEM2( 1 ),
- + $ ELEM3( 1 ), ELEM4, WR( K-1 ),
- + $ WI( K-1 ), WR( K ), WI( K ), SN, CS )
- ELSE
- WR( K ) = ELEM1
- END IF
- @@ -620,12 +621,12 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
- CALL INFOG2L( K+1, K+1, DESCH, NPROW, NPCOL, MYROW, MYCOL,
- $ ILOC4, JLOC4, HRSRC4, HCSRC4 )
- IF( MYROW.EQ.HRSRC2 .AND. MYCOL.EQ.HCSRC2 ) THEN
- - ELEM2 = H((JLOC2-1)*LLDH+ILOC2)
- + ELEM2( 1 ) = H((JLOC2-1)*LLDH+ILOC2)
- IF( HRSRC1.NE.HRSRC2 .OR. HCSRC1.NE.HCSRC2 )
- $ CALL SGESD2D( ICTXT, 1, 1, ELEM2, 1, HRSRC1, HCSRC1)
- END IF
- IF( MYROW.EQ.HRSRC3 .AND. MYCOL.EQ.HCSRC3 ) THEN
- - ELEM3 = H((JLOC3-1)*LLDH+ILOC3)
- + ELEM3( 1 ) = H((JLOC3-1)*LLDH+ILOC3)
- IF( HRSRC1.NE.HRSRC3 .OR. HCSRC1.NE.HCSRC3 )
- $ CALL SGESD2D( ICTXT, 1, 1, ELEM3, 1, HRSRC1, HCSRC1)
- END IF
- @@ -651,8 +652,9 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
- ELEM5 = WORK(2)
- IF( ELEM5.EQ.ZERO ) THEN
- IF( WR( K ).EQ.ZERO .AND. WI( K ).EQ.ZERO ) THEN
- - CALL SLANV2( ELEM1, ELEM2, ELEM3, ELEM4, WR( K ),
- - $ WI( K ), WR( K+1 ), WI( K+1 ), SN, CS )
- + CALL SLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ELEM4,
- + $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), SN,
- + $ CS )
- ELSEIF( WR( K+1 ).EQ.ZERO .AND. WI( K+1 ).EQ.ZERO )
- $ THEN
- WR( K+1 ) = ELEM4
- diff --git a/SRC/pslacon.f b/SRC/pslacon.f
- index 20d27ff..673bf1a 100644
- --- a/SRC/pslacon.f
- +++ b/SRC/pslacon.f
- @@ -160,10 +160,12 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- INTEGER I, ICTXT, IFLAG, IIVX, IMAXROW, IOFFVX, IROFF,
- $ ITER, IVXCOL, IVXROW, J, JLAST, JJVX, JUMP,
- $ K, MYCOL, MYROW, NP, NPCOL, NPROW
- - REAL ALTSGN, ESTOLD, JLMAX, TEMP, XMAX
- + REAL ALTSGN, ESTOLD, JLMAX, XMAX
- * ..
- * .. Local Arrays ..
- REAL WORK( 2 )
- + REAL ESTWORK( 1 )
- + REAL TEMP( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, IGSUM2D, INFOG2L, PSAMAX,
- @@ -184,6 +186,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- *
- * Get grid parameters.
- *
- + ESTWORK( 1 ) = EST
- ICTXT = DESCX( CTXT_ )
- CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
- *
- @@ -215,21 +218,21 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- IF( N.EQ.1 ) THEN
- IF( MYROW.EQ.IVXROW ) THEN
- V( IOFFVX ) = X( IOFFVX )
- - EST = ABS( V( IOFFVX ) )
- - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
- + ESTWORK( 1 ) = ABS( V( IOFFVX ) )
- + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
- ELSE
- - CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
- + CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
- $ IVXROW, MYCOL )
- END IF
- * ... QUIT
- GO TO 150
- END IF
- - CALL PSASUM( N, EST, X, IX, JX, DESCX, 1 )
- + CALL PSASUM( N, ESTWORK( 1 ), X, IX, JX, DESCX, 1 )
- IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
- IF( MYROW.EQ.IVXROW ) THEN
- - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
- + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
- ELSE
- - CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
- + CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
- $ IVXROW, MYCOL )
- END IF
- END IF
- @@ -281,13 +284,13 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- *
- 70 CONTINUE
- CALL SCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 )
- - ESTOLD = EST
- - CALL PSASUM( N, EST, V, IV, JV, DESCV, 1 )
- + ESTOLD = ESTWORK( 1 )
- + CALL PSASUM( N, ESTWORK( 1 ), V, IV, JV, DESCV, 1 )
- IF( DESCV( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
- IF( MYROW.EQ.IVXROW ) THEN
- - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
- + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
- ELSE
- - CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
- + CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
- $ IVXROW, MYCOL )
- END IF
- END IF
- @@ -305,7 +308,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
- * ALONG WITH IT, TEST FOR CYCLING.
- *
- - IF( IFLAG.EQ.0 .OR. EST.LE.ESTOLD )
- + IF( IFLAG.EQ.0 .OR. ESTWORK( 1 ).LE.ESTOLD )
- $ GO TO 120
- *
- DO 100 I = IOFFVX, IOFFVX+NP-1
- @@ -361,7 +364,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- * X HAS BEEN OVERWRITTEN BY A*X
- *
- 140 CONTINUE
- - CALL PSASUM( N, TEMP, X, IX, JX, DESCX, 1 )
- + CALL PSASUM( N, TEMP( 1 ), X, IX, JX, DESCX, 1 )
- IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
- IF( MYROW.EQ.IVXROW ) THEN
- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, TEMP, 1 )
- @@ -370,15 +373,16 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
- $ IVXROW, MYCOL )
- END IF
- END IF
- - TEMP = TWO*( TEMP / REAL( 3*N ) )
- - IF( TEMP.GT.EST ) THEN
- + TEMP( 1 ) = TWO*( TEMP( 1 ) / REAL( 3*N ) )
- + IF( TEMP( 1 ).GT.ESTWORK( 1 ) ) THEN
- CALL SCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 )
- - EST = TEMP
- + ESTWORK( 1 ) = TEMP( 1 )
- END IF
- *
- 150 CONTINUE
- KASE = 0
- *
- + EST = ESTWORK( 1 )
- RETURN
- *
- * End of PSLACON
- diff --git a/SRC/pslarf.f b/SRC/pslarf.f
- index c1d3a15..39de0ed 100644
- --- a/SRC/pslarf.f
- +++ b/SRC/pslarf.f
- @@ -241,7 +241,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
- $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
- $ NQ, RDEST
- - REAL TAULOC
- + REAL TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBSTRNV,
- @@ -335,7 +335,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -344,7 +344,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -362,8 +362,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -378,9 +378,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYCOL.EQ.ICCOL ) THEN
- *
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -397,8 +397,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL SGER( MP, NQ, -TAULOC, V( IOFFV ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + CALL SGER( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -420,9 +420,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = MP+1
- CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -440,7 +440,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL SGER( MP, NQ, -TAULOC, WORK, 1,
- + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -470,7 +470,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -479,7 +479,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -499,8 +499,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( IOFFC.GT.0 )
- - $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -515,18 +515,18 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( JJV )
- CALL SGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- IPW = MP+1
- CALL SGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -546,8 +546,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( IOFFC.GT.0 )
- - $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -576,9 +576,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYROW.EQ.ICROW ) THEN
- *
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -596,7 +596,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - w * v'
- *
- IF( IOFFV.GT.0 .AND. IOFFC.GT.0 )
- - $ CALL SGER( MP, NQ, -TAULOC, WORK, 1,
- + $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC ), LDC )
- END IF
- *
- @@ -619,9 +619,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = NQ+1
- CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -639,7 +639,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1,
- + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -665,7 +665,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -674,7 +674,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -692,8 +692,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1
- + $ , WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -718,18 +718,18 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( IIV )
- CALL SGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- IPW = NQ+1
- CALL SGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -748,8 +748,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - w * v'
- *
- IF( IOFFC.GT.0 )
- - $ CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -768,7 +768,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -777,7 +777,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -795,8 +795,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
- - $ C( IOFFC ), LDC )
- + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, WORK,
- + $ 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pslarz.f b/SRC/pslarz.f
- index aa70db7..8901530 100644
- --- a/SRC/pslarz.f
- +++ b/SRC/pslarz.f
- @@ -250,7 +250,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
- $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
- $ NQC2, NQV, RDEST
- - REAL TAULOC
- + REAL TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBSTRNV,
- @@ -369,7 +369,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -378,7 +378,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -401,9 +401,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL SGER( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -419,9 +419,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYCOL.EQ.ICCOL2 ) THEN
- *
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -444,11 +444,11 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL SAXPY( NQC2, -TAULOC, WORK,
- + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK,
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL SGER( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL SGER( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -470,9 +470,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = MPV+1
- CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -495,10 +495,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL SGER( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -529,7 +529,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -538,7 +538,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -561,10 +561,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -579,18 +579,18 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( JJV )
- CALL SGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- IPW = MPV+1
- CALL SGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -613,10 +613,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -645,9 +645,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYROW.EQ.ICROW2 ) THEN
- *
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -668,13 +668,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ ICCOL2 )
- *
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL SAXPY( MPC2, -TAULOC, WORK, 1,
- + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- IF( MPC2.GT.0 .AND. NQV.GT.0 )
- - $ CALL SGER( MPC2, NQV, -TAULOC, WORK, 1,
- + $ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC2 ),
- $ LDC )
- END IF
- @@ -698,9 +698,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = NQV+1
- CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -719,13 +719,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ),
- $ RDEST, ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- - $ C( IOFFC1 ), 1 )
- + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -750,7 +750,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -759,7 +759,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -778,12 +778,12 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- + CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -808,18 +808,18 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( IIV )
- CALL SGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- IPW = NQV+1
- CALL SGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -839,13 +839,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -864,7 +864,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -873,7 +873,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -892,13 +892,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pslawil.f b/SRC/pslawil.f
- index e04c16b..671e08e 100644
- --- a/SRC/pslawil.f
- +++ b/SRC/pslawil.f
- @@ -120,10 +120,14 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- INTEGER CONTXT, DOWN, HBL, ICOL, IROW, JSRC, LDA, LEFT,
- $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT,
- $ RSRC, UP
- - REAL H11, H12, H21, H22, H33S, H44S, S, V1, V2, V3
- + REAL H22, H33S, H44S, S, V1, V2
- * ..
- * .. Local Arrays ..
- REAL BUF( 4 )
- + REAL H11( 1 )
- + REAL H12( 1 )
- + REAL H21( 1 )
- + REAL V3( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, SGERV2D, SGESD2D, INFOG2L
- @@ -170,18 +174,18 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( NPCOL.GT.1 ) THEN
- CALL SGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT )
- ELSE
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- IF( NUM.GT.1 ) THEN
- CALL SGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT )
- - H11 = BUF( 1 )
- - H21 = BUF( 2 )
- - H12 = BUF( 3 )
- + H11( 1 ) = BUF( 1 )
- + H21( 1 ) = BUF( 2 )
- + H12( 1 ) = BUF( 3 )
- H22 = BUF( 4 )
- ELSE
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- END IF
- END IF
- @@ -214,20 +218,20 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( NUM.GT.1 ) THEN
- CALL SGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT )
- ELSE
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- END IF
- IF( NPROW.GT.1 ) THEN
- CALL SGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL )
- ELSE
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- END IF
- IF( NPCOL.GT.1 ) THEN
- CALL SGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT )
- ELSE
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- END IF
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- END IF
- IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) )
- @@ -236,24 +240,24 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( MODKM1.GT.1 ) THEN
- CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
- $ IROW, ICOL, RSRC, JSRC )
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- *
- - H44S = H44 - H11
- - H33S = H33 - H11
- - V1 = ( H33S*H44S-H43H34 ) / H21 + H12
- - V2 = H22 - H11 - H33S - H44S
- - S = ABS( V1 ) + ABS( V2 ) + ABS( V3 )
- + H44S = H44 - H11( 1 )
- + H33S = H33 - H11( 1 )
- + V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 )
- + V2 = H22 - H11( 1 ) - H33S - H44S
- + S = ABS( V1 ) + ABS( V2 ) + ABS( V3( 1 ) )
- V1 = V1 / S
- V2 = V2 / S
- - V3 = V3 / S
- + V3( 1 ) = V3( 1 ) / S
- V( 1 ) = V1
- V( 2 ) = V2
- - V( 3 ) = V3
- + V( 3 ) = V3( 1 )
- *
- RETURN
- *
- diff --git a/SRC/psstebz.f b/SRC/psstebz.f
- index a8a2496..7e588a9 100644
- --- a/SRC/psstebz.f
- +++ b/SRC/psstebz.f
- @@ -244,14 +244,14 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU,
- $ ITMP2, J, JB, K, LAST, LEXTRA, LREQ, MYCOL,
- $ MYROW, NALPHA, NBETA, NCMP, NEIGINT, NEXT, NGL,
- $ NGLOB, NGU, NINT, NPCOL, NPROW, OFFSET,
- - $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF,
- - $ TORECV
- + $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF
- REAL ALPHA, ATOLI, BETA, BNORM, DRECV, DSEND, GL,
- $ GU, INITVL, INITVU, LSAVE, MID, PIVMIN, RELTOL,
- $ SAFEMN, TMP1, TMP2, TNORM, ULP
- * ..
- * .. Local Arrays ..
- INTEGER IDUM( 5, 2 )
- + INTEGER TORECV( 1, 1 )
- * ..
- * .. Executable Statements ..
- * This is just to keep ftnchek happy
- @@ -774,14 +774,14 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU,
- ELSE
- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', 1, 1, TORECV, 1, 0,
- $ I-1 )
- - IF( TORECV.NE.0 ) THEN
- - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, IWORK,
- - $ TORECV, 0, I-1 )
- - CALL SGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, WORK,
- - $ TORECV, 0, I-1 )
- - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1,
- - $ IWORK( N+1 ), TORECV, 0, I-1 )
- - DO 120 J = 1, TORECV
- + IF( TORECV( 1, 1 ).NE.0 ) THEN
- + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
- + $ IWORK, TORECV( 1, 1 ), 0, I-1 )
- + CALL SGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
- + $ WORK, TORECV( 1, 1 ), 0, I-1 )
- + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
- + $ IWORK( N+1 ), TORECV( 1, 1 ), 0, I-1 )
- + DO 120 J = 1, TORECV( 1, 1 )
- W( IWORK( J ) ) = WORK( J )
- IBLOCK( IWORK( J ) ) = IWORK( N+J )
- 120 CONTINUE
- diff --git a/SRC/pstrord.f b/SRC/pstrord.f
- index 3562242..5cdb549 100644
- --- a/SRC/pstrord.f
- +++ b/SRC/pstrord.f
- @@ -328,12 +328,13 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- $ EAST, WEST, ILOC4, SOUTH, NORTH, INDXS,
- $ ITT, JTT, ILEN, DLEN, INDXE, TRSRC1, TCSRC1,
- $ TRSRC2, TCSRC2, ILOS, DIR, TLIHI, TLILO, TLSEL,
- - $ ROUND, LAST, WIN0S, WIN0E, WINE, MMAX, MMIN
- + $ ROUND, LAST, WIN0S, WIN0E, WINE
- REAL ELEM, ELEM1, ELEM2, ELEM3, ELEM4, SN, CS, TMP,
- $ ELEM5
- * ..
- * .. Local Arrays ..
- - INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 )
- + INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ), MMAX( 1 ),
- + $ MMIN( 1 ), INFODUM( 1 )
- * ..
- * .. External Functions ..
- LOGICAL LSAME
- @@ -483,16 +484,16 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- END IF
- IF( SELECT(K).NE.0 ) M = M + 1
- 10 CONTINUE
- - MMAX = M
- - MMIN = M
- + MMAX( 1 ) = M
- + MMIN( 1 ) = M
- IF( NPROCS.GT.1 )
- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1,
- $ -1, -1, -1, -1 )
- IF( NPROCS.GT.1 )
- $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1,
- $ -1, -1, -1, -1 )
- - IF( MMAX.GT.MMIN ) THEN
- - M = MMAX
- + IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN
- + M = MMAX( 1 )
- IF( NPROCS.GT.1 )
- $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, SELECT, N,
- $ -1, -1, -1, -1, -1 )
- @@ -520,9 +521,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- *
- * Global maximum on info.
- *
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1,
- - $ -1, -1 )
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1,
- + $ -1, -1, -1 )
- + INFO = INFODUM( 1 )
- + END IF
- *
- * Return if some argument is incorrect.
- *
- @@ -1576,9 +1579,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- * experienced a failure in the reordering.
- *
- MYIERR = IERR
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
- $ -1, -1, -1, -1 )
- + IERR = INFODUM( 1 )
- + END IF
- *
- IF( IERR.NE.0 ) THEN
- *
- @@ -1586,9 +1591,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- * to swap.
- *
- IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1)
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
- $ -1, -1, -1, -1 )
- + INFO = INFODUM( 1 )
- + END IF
- GO TO 300
- END IF
- *
- @@ -3245,9 +3252,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- * experienced a failure in the reordering.
- *
- MYIERR = IERR
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
- $ -1, -1, -1, -1 )
- + IERR = INFODUM( 1 )
- + END IF
- *
- IF( IERR.NE.0 ) THEN
- *
- @@ -3255,9 +3264,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
- * to swap.
- *
- IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1)
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
- $ -1, -1, -1, -1 )
- + INFO = INFODUM( 1 )
- + END IF
- GO TO 300
- END IF
- *
- diff --git a/SRC/pstrsen.f b/SRC/pstrsen.f
- index 6219bdb..1922e8f 100644
- --- a/SRC/pstrsen.f
- +++ b/SRC/pstrsen.f
- @@ -354,13 +354,15 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
- LOGICAL LQUERY, WANTBH, WANTQ, WANTS, WANTSP
- INTEGER ICOFFT12, ICTXT, IDUM1, IDUM2, IERR, ILOC1,
- $ IPW1, ITER, ITT, JLOC1, JTT, K, LIWMIN, LLDT,
- - $ LLDQ, LWMIN, MMAX, MMIN, MYROW, MYCOL, N1, N2,
- + $ LLDQ, LWMIN, MYROW, MYCOL, N1, N2,
- $ NB, NOEXSY, NPCOL, NPROCS, NPROW, SPACE,
- $ T12ROWS, T12COLS, TCOLS, TCSRC, TROWS, TRSRC,
- $ WRK1, IWRK1, WRK2, IWRK2, WRK3, IWRK3
- - REAL DPDUM1, ELEM, EST, SCALE, RNORM
- + REAL ELEM, EST, SCALE, RNORM
- * .. Local Arrays ..
- - INTEGER DESCT12( DLEN_ ), MBNB2( 2 )
- + INTEGER DESCT12( DLEN_ ), MBNB2( 2 ), MMAX( 1 ),
- + $ MMIN( 1 ), INFODUM( 1 )
- + REAL DPDUM1( 1 )
- * ..
- * .. External Functions ..
- LOGICAL LSAME
- @@ -521,16 +523,16 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
- END IF
- IF( SELECT(K) ) M = M + 1
- 10 CONTINUE
- - MMAX = M
- - MMIN = M
- + MMAX( 1 ) = M
- + MMIN( 1 ) = M
- IF( NPROCS.GT.1 )
- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1,
- $ -1, -1, -1, -1 )
- IF( NPROCS.GT.1 )
- $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1,
- $ -1, -1, -1, -1 )
- - IF( MMAX.GT.MMIN ) THEN
- - M = MMAX
- + IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN
- + M = MMAX( 1 )
- IF( NPROCS.GT.1 )
- $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, IWORK, N,
- $ -1, -1, -1, -1, -1 )
- @@ -602,9 +604,11 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
- *
- * Global maximum on info
- *
- - IF( NPROCS.GT.1 )
- - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1,
- + IF( NPROCS.GT.1 ) THEN
- + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, -1,
- $ -1, -1 )
- + INFO = INFODUM( 1 )
- + END IF
- *
- * Return if some argument is incorrect
- *
- diff --git a/SRC/pzlarf.f b/SRC/pzlarf.f
- index df65912..7bff287 100644
- --- a/SRC/pzlarf.f
- +++ b/SRC/pzlarf.f
- @@ -242,7 +242,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
- $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
- $ NQ, RDEST
- - COMPLEX*16 TAULOC
- + COMPLEX*16 TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV,
- @@ -336,7 +336,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -345,7 +345,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -363,8 +363,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -379,9 +379,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYCOL.EQ.ICCOL ) THEN
- *
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -398,7 +398,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, V( IOFFV ), 1,
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
- $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -421,9 +421,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = MP+1
- CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -441,7 +441,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1,
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -471,7 +471,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -480,7 +480,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -500,8 +500,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( IOFFC.GT.0 )
- - $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -516,18 +516,18 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( JJV )
- CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- IPW = MP+1
- CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -547,8 +547,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( IOFFC.GT.0 )
- - $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -577,9 +577,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYROW.EQ.ICROW ) THEN
- *
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -597,7 +597,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - w * v'
- *
- IF( IOFFV.GT.0 .AND. IOFFC.GT.0 )
- - $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1,
- + $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC ),
- $ LDC )
- END IF
- @@ -621,9 +621,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = NQ+1
- CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -641,8 +641,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -667,7 +667,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -676,7 +676,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -694,8 +694,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -720,18 +720,18 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( IIV )
- CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- IPW = NQ+1
- CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -750,8 +750,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- * sub( C ) := sub( C ) - w * v'
- *
- IF( IOFFC.GT.0 )
- - $ CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -770,7 +770,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -779,7 +779,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -797,8 +797,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
- - $ C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pzlarfc.f b/SRC/pzlarfc.f
- index eb469fc..ddd7ec6 100644
- --- a/SRC/pzlarfc.f
- +++ b/SRC/pzlarfc.f
- @@ -242,7 +242,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
- $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
- $ NQ, RDEST
- - COMPLEX*16 TAULOC
- + COMPLEX*16 TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV,
- @@ -336,17 +336,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = DCONJG( TAU( IIV ) )
- + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
- *
- ELSE
- *
- CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAULOC, 1, IVROW, MYCOL )
- - TAULOC = DCONJG( TAULOC )
- + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -364,8 +364,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -380,9 +380,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYCOL.EQ.ICCOL ) THEN
- *
- - TAULOC = DCONJG( TAU( JJV ) )
- + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -399,7 +399,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, V( IOFFV ), 1,
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
- $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -422,9 +422,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = MP+1
- CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = DCONJG( WORK( IPW ) )
- + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -442,7 +442,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1,
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- @@ -472,17 +472,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = DCONJG( TAU( IIV ) )
- + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
- *
- ELSE
- *
- CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
- $ 1, IVROW, MYCOL )
- - TAULOC = DCONJG( TAULOC )
- + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -500,8 +500,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1,
- - $ C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -516,18 +516,18 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( JJV )
- CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = DCONJG( TAU( JJV ) )
- + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
- *
- ELSE
- *
- IPW = MP+1
- CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = DCONJG( WORK( IPW ) )
- + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -545,8 +545,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - v * w'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1,
- - $ C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -575,9 +575,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- IF( MYROW.EQ.ICROW ) THEN
- *
- - TAULOC = DCONJG( TAU( IIV ) )
- + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -594,7 +594,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1,
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC ), LDC )
- END IF
- *
- @@ -617,9 +617,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- IPW = NQ+1
- CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = DCONJG( WORK( IPW ) )
- + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -637,8 +637,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -663,17 +663,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = DCONJG( TAU( JJV ) )
- + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
- *
- ELSE
- *
- CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
- $ 1, MYROW, IVCOL )
- - TAULOC = DCONJG( TAULOC )
- + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -691,8 +691,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- @@ -716,18 +716,18 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- WORK(IPW) = TAU( IIV )
- CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = DCONJG( TAU( IIV ) )
- + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
- *
- ELSE
- *
- IPW = NQ+1
- CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = DCONJG( WORK( IPW ) )
- + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -745,8 +745,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
- - $ C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- ELSE
- @@ -765,17 +765,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = DCONJG( TAU( JJV ) )
- + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
- *
- ELSE
- *
- CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1,
- $ MYROW, IVCOL )
- - TAULOC = DCONJG( TAULOC )
- + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -793,8 +793,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
- - $ C( IOFFC ), LDC )
- + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pzlarz.f b/SRC/pzlarz.f
- index fefc133..abf6288 100644
- --- a/SRC/pzlarz.f
- +++ b/SRC/pzlarz.f
- @@ -251,7 +251,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
- $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
- $ NQC2, NQV, RDEST
- - COMPLEX*16 TAULOC
- + COMPLEX*16 TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV,
- @@ -370,7 +370,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -379,7 +379,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -402,9 +402,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -420,9 +420,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYCOL.EQ.ICCOL2 ) THEN
- *
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -445,11 +445,11 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK,
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK,
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -471,9 +471,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = MPV+1
- CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -496,10 +496,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -530,7 +530,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- @@ -539,7 +539,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -562,10 +562,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -580,18 +580,18 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( JJV )
- CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- IPW = MPV+1
- CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -614,10 +614,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -646,9 +646,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYROW.EQ.ICROW2 ) THEN
- *
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -669,13 +669,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ ICCOL2 )
- *
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK, 1,
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- IF( MPC2.GT.0 .AND. NQV.GT.0 )
- - $ CALL ZGERC( MPC2, NQV, -TAULOC, WORK, 1,
- + $ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC2 ),
- $ LDC )
- END IF
- @@ -699,9 +699,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = NQV+1
- CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -720,13 +720,14 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ),
- $ RDEST, ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- - $ C( IOFFC1 ), 1 )
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ),
- + $ WORK( IPW ), 1, WORK, 1,
- + $ C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -751,7 +752,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -760,7 +761,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -779,13 +780,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -809,18 +810,18 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( IIV )
- CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = TAU( IIV )
- + TAULOC( 1 ) = TAU( IIV )
- *
- ELSE
- *
- IPW = NQV+1
- CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = WORK( IPW )
- + TAULOC( 1 ) = WORK( IPW )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -840,13 +841,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -865,7 +866,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = TAU( JJV )
- + TAULOC( 1 ) = TAU( JJV )
- *
- ELSE
- *
- @@ -874,7 +875,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -893,13 +894,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pzlarzc.f b/SRC/pzlarzc.f
- index 936caec..2c574ff 100644
- --- a/SRC/pzlarzc.f
- +++ b/SRC/pzlarzc.f
- @@ -251,7 +251,7 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
- $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
- $ NQC2, NQV, RDEST
- - COMPLEX*16 TAULOC
- + COMPLEX*16 TAULOC( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV,
- @@ -370,17 +370,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = DCONJG( TAU( IIV ) )
- + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
- *
- ELSE
- *
- CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAULOC, 1, IVROW, MYCOL )
- - TAULOC = DCONJG( TAULOC )
- + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -403,9 +403,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -421,9 +421,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYCOL.EQ.ICCOL2 ) THEN
- *
- - TAULOC = DCONJG( TAU( JJV ) )
- + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -446,11 +446,11 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK,
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK,
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -472,9 +472,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = MPV+1
- CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
- $ IVCOL )
- - TAULOC = DCONJG( WORK( IPW ) )
- + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -497,10 +497,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ),
- $ LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1,
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -531,17 +531,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
- $ TAU( IIV ), 1 )
- - TAULOC = DCONJG( TAU( IIV ) )
- + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
- *
- ELSE
- *
- CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
- $ 1, IVROW, MYCOL )
- - TAULOC = DCONJG( TAULOC )
- + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -564,10 +564,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -582,18 +582,18 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( JJV )
- CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = DCONJG( TAU( JJV ) )
- + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
- *
- ELSE
- *
- IPW = MPV+1
- CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
- $ IPW, MYROW, IVCOL )
- - TAULOC = DCONJG( WORK( IPW ) )
- + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C )' * v
- *
- @@ -616,10 +616,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- * sub( C ) := sub( C ) - v * w'
- *
- IF( MYROW.EQ.ICROW1 )
- - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
- + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
- $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
- - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
- - $ 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
- + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -648,9 +648,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- IF( MYROW.EQ.ICROW2 ) THEN
- *
- - TAULOC = DCONJG( TAU( IIV ) )
- + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -671,12 +671,12 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ ICCOL2 )
- *
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK, 1,
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MPC2, NQV, -TAULOC, WORK, 1,
- + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
- $ V( IOFFV ), LDV, C( IOFFC2 ), LDC )
- END IF
- *
- @@ -699,9 +699,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- IPW = NQV+1
- CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
- $ MYCOL )
- - TAULOC = DCONJG( WORK( IPW ) )
- + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -720,13 +720,14 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ),
- $ RDEST, ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- - $ C( IOFFC1 ), 1 )
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ),
- + $ WORK( IPW ), 1, WORK, 1,
- + $ C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -751,17 +752,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
- $ TAU( JJV ), 1 )
- - TAULOC = DCONJG( TAU( JJV ) )
- + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
- *
- ELSE
- *
- CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
- $ 1, MYROW, IVCOL )
- - TAULOC = DCONJG( TAULOC )
- + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -780,13 +781,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
- - $ WORK, 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
- + $ 1, WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- @@ -810,18 +811,18 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- WORK( IPW ) = TAU( IIV )
- CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW )
- - TAULOC = DCONJG( TAU( IIV ) )
- + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
- *
- ELSE
- *
- IPW = NQV+1
- CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
- $ WORK, IPW, IVROW, MYCOL )
- - TAULOC = DCONJG( WORK( IPW ) )
- + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -841,13 +842,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- ELSE
- @@ -866,17 +867,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- *
- CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
- $ 1 )
- - TAULOC = DCONJG( TAU( JJV ) )
- + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
- *
- ELSE
- *
- CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1,
- $ MYROW, IVCOL )
- - TAULOC = DCONJG( TAULOC )
- + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
- *
- END IF
- *
- - IF( TAULOC.NE.ZERO ) THEN
- + IF( TAULOC( 1 ).NE.ZERO ) THEN
- *
- * w := sub( C ) * v
- *
- @@ -895,13 +896,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
- $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
- $ ICCOL2 )
- IF( MYCOL.EQ.ICCOL1 )
- - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
- + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
- $ C( IOFFC1 ), 1 )
- *
- * sub( C ) := sub( C ) - w * v'
- *
- - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
- - $ 1, C( IOFFC2 ), LDC )
- + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
- + $ WORK, 1, C( IOFFC2 ), LDC )
- END IF
- *
- END IF
- diff --git a/SRC/pzlattrs.f b/SRC/pzlattrs.f
- index 819e476..5a54209 100644
- --- a/SRC/pzlattrs.f
- +++ b/SRC/pzlattrs.f
- @@ -271,8 +271,9 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- $ JINC, JLAST, LDA, LDX, MB, MYCOL, MYROW, NB,
- $ NPCOL, NPROW, RSRC
- DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL,
- - $ XBND, XJ, XMAX
- + $ XBND, XJ
- COMPLEX*16 CSUMJ, TJJS, USCAL, XJTMP, ZDUM
- + DOUBLE PRECISION XMAX( 1 )
- * ..
- * .. External Functions ..
- LOGICAL LSAME
- @@ -391,11 +392,11 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- * Compute a bound on the computed solution vector to see if the
- * Level 2 PBLAS routine PZTRSV can be used.
- *
- - XMAX = ZERO
- + XMAX( 1 ) = ZERO
- CALL PZAMAX( N, ZDUM, IMAX, X, IX, JX, DESCX, 1 )
- - XMAX = CABS2( ZDUM )
- + XMAX( 1 ) = CABS2( ZDUM )
- CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, -1, -1 )
- - XBND = XMAX
- + XBND = XMAX( 1 )
- *
- IF( NOTRAN ) THEN
- *
- @@ -590,16 +591,16 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- *
- * Use a Level 1 PBLAS solve, scaling intermediate results.
- *
- - IF( XMAX.GT.BIGNUM*HALF ) THEN
- + IF( XMAX( 1 ).GT.BIGNUM*HALF ) THEN
- *
- * Scale X so that its components are less than or equal to
- * BIGNUM in absolute value.
- *
- - SCALE = ( BIGNUM*HALF ) / XMAX
- + SCALE = ( BIGNUM*HALF ) / XMAX( 1 )
- CALL PZDSCAL( N, SCALE, X, IX, JX, DESCX, 1 )
- - XMAX = BIGNUM
- + XMAX( 1 ) = BIGNUM
- ELSE
- - XMAX = XMAX*TWO
- + XMAX( 1 ) = XMAX( 1 )*TWO
- END IF
- *
- IF( NOTRAN ) THEN
- @@ -651,7 +652,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- * X( J ) = ZLADIV( X( J ), TJJS )
- @@ -682,7 +683,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- * X( J ) = ZLADIV( X( J ), TJJS )
- * XJ = CABS1( X( J ) )
- @@ -706,7 +707,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- XJTMP = CONE
- XJ = ONE
- SCALE = ZERO
- - XMAX = ZERO
- + XMAX( 1 ) = ZERO
- END IF
- 90 CONTINUE
- *
- @@ -715,7 +716,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- *
- IF( XJ.GT.ONE ) THEN
- REC = ONE / XJ
- - IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
- + IF( CNORM( J ).GT.( BIGNUM-XMAX( 1 ) )*REC ) THEN
- *
- * Scale x by 1/(2*abs(x(j))).
- *
- @@ -724,7 +725,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- END IF
- - ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
- + ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX( 1 ) ) ) THEN
- *
- * Scale x by 1/2.
- *
- @@ -743,7 +744,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZAXPY( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1, X,
- $ IX, JX, DESCX, 1 )
- CALL PZAMAX( J-1, ZDUM, IMAX, X, IX, JX, DESCX, 1 )
- - XMAX = CABS1( ZDUM )
- + XMAX( 1 ) = CABS1( ZDUM )
- CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1,
- $ -1, -1 )
- END IF
- @@ -757,7 +758,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZAXPY( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1,
- $ X, IX+J, JX, DESCX, 1 )
- CALL PZAMAX( N-J, ZDUM, I, X, IX+J, JX, DESCX, 1 )
- - XMAX = CABS1( ZDUM )
- + XMAX( 1 ) = CABS1( ZDUM )
- CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1,
- $ -1, -1 )
- END IF
- @@ -785,7 +786,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- END IF
- XJ = CABS1( XJTMP )
- USCAL = DCMPLX( TSCAL )
- - REC = ONE / MAX( XMAX, ONE )
- + REC = ONE / MAX( XMAX( 1 ), ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
- *
- * If x(j) could overflow, scale x by 1/(2*XMAX).
- @@ -820,7 +821,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- *
- @@ -924,7 +925,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- * X( J ) = ZLADIV( X( J ), TJJS )
- @@ -945,7 +946,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- * X( J ) = ZLADIV( X( J ), TJJS )
- XJTMP = ZLADIV( XJTMP, TJJS )
- @@ -966,7 +967,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- END IF
- XJTMP = CONE
- SCALE = ZERO
- - XMAX = ZERO
- + XMAX( 1 ) = ZERO
- END IF
- 110 CONTINUE
- ELSE
- @@ -981,7 +982,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- X( IROWX ) = XJTMP
- END IF
- END IF
- - XMAX = MAX( XMAX, CABS1( XJTMP ) )
- + XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) )
- 120 CONTINUE
- *
- ELSE
- @@ -1004,7 +1005,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- END IF
- XJ = CABS1( XJTMP )
- USCAL = TSCAL
- - REC = ONE / MAX( XMAX, ONE )
- + REC = ONE / MAX( XMAX( 1 ), ONE )
- IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
- *
- * If x(j) could overflow, scale x by 1/(2*XMAX).
- @@ -1039,7 +1040,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- *
- @@ -1145,7 +1146,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- END IF
- * X( J ) = ZLADIV( X( J ), TJJS )
- @@ -1164,7 +1165,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
- XJTMP = XJTMP*REC
- SCALE = SCALE*REC
- - XMAX = XMAX*REC
- + XMAX( 1 ) = XMAX( 1 )*REC
- END IF
- * X( J ) = ZLADIV( X( J ), TJJS )
- XJTMP = ZLADIV( XJTMP, TJJS )
- @@ -1181,7 +1182,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- $ X( IROWX ) = CONE
- XJTMP = CONE
- SCALE = ZERO
- - XMAX = ZERO
- + XMAX( 1 ) = ZERO
- END IF
- 130 CONTINUE
- ELSE
- @@ -1194,7 +1195,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
- IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
- $ X( IROWX ) = XJTMP
- END IF
- - XMAX = MAX( XMAX, CABS1( XJTMP ) )
- + XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) )
- 140 CONTINUE
- END IF
- SCALE = SCALE / TSCAL
- diff --git a/SRC/pzlawil.f b/SRC/pzlawil.f
- index e89a9a3..7e502ef 100644
- --- a/SRC/pzlawil.f
- +++ b/SRC/pzlawil.f
- @@ -124,11 +124,10 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT,
- $ RSRC, UP
- DOUBLE PRECISION S
- - COMPLEX*16 CDUM, H11, H12, H21, H22, H33S, H44S, V1, V2,
- - $ V3
- + COMPLEX*16 CDUM, H22, H33S, H44S, V1, V2
- * ..
- * .. Local Arrays ..
- - COMPLEX*16 BUF( 4 )
- + COMPLEX*16 BUF( 4 ), H11( 1 ), H12( 1 ), H21( 1 ), V3( 1 )
- * ..
- * .. External Subroutines ..
- EXTERNAL BLACS_GRIDINFO, INFOG2L, ZGERV2D, ZGESD2D
- @@ -181,18 +180,18 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( NPCOL.GT.1 ) THEN
- CALL ZGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT )
- ELSE
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- IF( NUM.GT.1 ) THEN
- CALL ZGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT )
- - H11 = BUF( 1 )
- - H21 = BUF( 2 )
- - H12 = BUF( 3 )
- + H11( 1 ) = BUF( 1 )
- + H21( 1 ) = BUF( 2 )
- + H12( 1 ) = BUF( 3 )
- H22 = BUF( 4 )
- ELSE
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- END IF
- END IF
- @@ -225,20 +224,20 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( NUM.GT.1 ) THEN
- CALL ZGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT )
- ELSE
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- END IF
- IF( NPROW.GT.1 ) THEN
- CALL ZGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL )
- ELSE
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- END IF
- IF( NPCOL.GT.1 ) THEN
- CALL ZGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT )
- ELSE
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- END IF
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- END IF
- IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) )
- @@ -247,24 +246,24 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
- IF( MODKM1.GT.1 ) THEN
- CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
- $ IROW, ICOL, RSRC, JSRC )
- - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
- - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
- - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
- + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
- + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
- + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
- H22 = A( ( ICOL-2 )*LDA+IROW-1 )
- - V3 = A( ( ICOL-2 )*LDA+IROW )
- + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
- END IF
- *
- - H44S = H44 - H11
- - H33S = H33 - H11
- - V1 = ( H33S*H44S-H43H34 ) / H21 + H12
- - V2 = H22 - H11 - H33S - H44S
- - S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3 )
- + H44S = H44 - H11( 1 )
- + H33S = H33 - H11( 1 )
- + V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 )
- + V2 = H22 - H11( 1 ) - H33S - H44S
- + S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3( 1 ) )
- V1 = V1 / S
- V2 = V2 / S
- - V3 = V3 / S
- + V3( 1 ) = V3( 1 ) / S
- V( 1 ) = V1
- V( 2 ) = V2
- - V( 3 ) = V3
- + V( 3 ) = V3( 1 )
- *
- RETURN
- *
- diff --git a/SRC/pztrevc.f b/SRC/pztrevc.f
- index 0536475..3b27286 100644
- --- a/SRC/pztrevc.f
- +++ b/SRC/pztrevc.f
- @@ -218,11 +218,12 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- $ ITMP2, J, K, KI, LDT, LDVL, LDVR, LDW, MB,
- $ MYCOL, MYROW, NB, NPCOL, NPROW, RSRC
- REAL SELF
- - DOUBLE PRECISION OVFL, REMAXD, SCALE, SMIN, SMLNUM, ULP, UNFL
- + DOUBLE PRECISION OVFL, REMAXD, SCALE, SMLNUM, ULP, UNFL
- COMPLEX*16 CDUM, REMAXC, SHIFT
- * ..
- * .. Local Arrays ..
- INTEGER DESCW( DLEN_ )
- + DOUBLE PRECISION SMIN( 1 )
- * ..
- * .. External Functions ..
- LOGICAL LSAME
- @@ -355,13 +356,13 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- $ GO TO 70
- END IF
- *
- - SMIN = ZERO
- + SMIN( 1 ) = ZERO
- SHIFT = CZERO
- CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL,
- $ IROW, ICOL, ITMP1, ITMP2 )
- IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
- SHIFT = T( ( ICOL-1 )*LDT+IROW )
- - SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
- + SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
- END IF
- CALL DGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 )
- CALL ZGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 )
- @@ -396,8 +397,9 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
- T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -
- $ SHIFT
- - IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) THEN
- - T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN )
- + IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) )
- + $ THEN
- + T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN( 1 ) )
- END IF
- END IF
- 50 CONTINUE
- @@ -467,13 +469,13 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- $ GO TO 110
- END IF
- *
- - SMIN = ZERO
- + SMIN( 1 ) = ZERO
- SHIFT = CZERO
- CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL,
- $ IROW, ICOL, ITMP1, ITMP2 )
- IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
- SHIFT = T( ( ICOL-1 )*LDT+IROW )
- - SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
- + SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
- END IF
- CALL DGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 )
- CALL ZGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 )
- @@ -507,8 +509,8 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
- IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
- T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -
- $ SHIFT
- - IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN )
- - $ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN )
- + IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) )
- + $ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN( 1 ) )
- END IF
- 90 CONTINUE
- *
- From 189c84001bcd564296a475c5c757afc9f337e828 Mon Sep 17 00:00:00 2001
- From: =?UTF-8?q?Tiziano=20M=C3=BCller?= <tiziano.mueller@chem.uzh.ch>
- Date: Thu, 25 Jun 2020 18:37:34 +0200
- Subject: [PATCH 2/2] use -std=legacy for tests with GCC-10+
- ---
- BLACS/TESTING/CMakeLists.txt | 10 +++++++---
- PBLAS/TESTING/CMakeLists.txt | 7 ++++---
- PBLAS/TIMING/CMakeLists.txt | 5 +++--
- TESTING/EIG/CMakeLists.txt | 3 +++
- TESTING/LIN/CMakeLists.txt | 4 ++++
- 5 files changed, 21 insertions(+), 8 deletions(-)
- diff --git a/BLACS/TESTING/CMakeLists.txt b/BLACS/TESTING/CMakeLists.txt
- index d8846b5..4e91ac2 100644
- --- a/BLACS/TESTING/CMakeLists.txt
- +++ b/BLACS/TESTING/CMakeLists.txt
- @@ -1,10 +1,14 @@
- -set(FTestObj
- +set(FTestObj
- blacstest.f btprim.f tools.f)
-
- +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
- + set_source_files_properties(blacstest.f PROPERTIES COMPILE_FLAGS "-std=legacy")
- +endif()
- +
- add_executable(xFbtest ${FTestObj})
- target_link_libraries(xFbtest scalapack)
-
- -set(CTestObj
- +set(CTestObj
- Cbt.c)
-
- set_property(
- @@ -46,4 +50,4 @@ add_test(xFbtest
- -DRUNTIMEDIR=${CMAKE_RUNTIME_OUTPUT_DIRECTORY}
- -DSOURCEDIR=${CMAKE_CURRENT_SOURCE_DIR}
- -P ${CMAKE_CURRENT_SOURCE_DIR}/runtest.cmake
- - )
- \ No newline at end of file
- + )
- diff --git a/PBLAS/TESTING/CMakeLists.txt b/PBLAS/TESTING/CMakeLists.txt
- index e60f5e4..ee77091 100644
- --- a/PBLAS/TESTING/CMakeLists.txt
- +++ b/PBLAS/TESTING/CMakeLists.txt
- @@ -10,7 +10,7 @@ set (zpbtcom pzblastst.f dlamch.f ${pbtcom})
-
- set_property(
- SOURCE ${PblasErrorHandler}
- - APPEND PROPERTY COMPILE_DEFINITIONS TestingPblas
- + APPEND PROPERTY COMPILE_DEFINITIONS TestingPblas
- )
-
- set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${SCALAPACK_BINARY_DIR}/PBLAS/TESTING)
- @@ -74,5 +74,6 @@ add_test(dpb3tst ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./dpb3tst)
- add_test(cpb3tst ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./cpb3tst)
- add_test(zpb3tst ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./zpb3tst)
-
- -
- -
- +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
- + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory
- +endif()
- diff --git a/PBLAS/TIMING/CMakeLists.txt b/PBLAS/TIMING/CMakeLists.txt
- index 763330f..208bbc3 100644
- --- a/PBLAS/TIMING/CMakeLists.txt
- +++ b/PBLAS/TIMING/CMakeLists.txt
- @@ -74,5 +74,6 @@ add_test(dpb3tim ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./dpb3tim)
- add_test(cpb3tim ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./cpb3tim)
- add_test(zpb3tim ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./zpb3tim)
-
- -
- -
- +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
- + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory
- +endif()
- diff --git a/TESTING/EIG/CMakeLists.txt b/TESTING/EIG/CMakeLists.txt
- index 97c7036..19a1f34 100644
- --- a/TESTING/EIG/CMakeLists.txt
- +++ b/TESTING/EIG/CMakeLists.txt
- @@ -97,3 +97,6 @@ target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
- target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
- target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
-
- +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
- + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory
- +endif()
- diff --git a/TESTING/LIN/CMakeLists.txt b/TESTING/LIN/CMakeLists.txt
- index 55a53e9..65f169b 100644
- --- a/TESTING/LIN/CMakeLists.txt
- +++ b/TESTING/LIN/CMakeLists.txt
- @@ -110,3 +110,7 @@ target_link_libraries(xsls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
- target_link_libraries(xdls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
- target_link_libraries(xcls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
- target_link_libraries(xzls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
- +
- +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
- + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory
- +endif()
|