ScaLAPACK-2.1.0_fix-GCC-10.patch 226 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683
  1. fix compilation errors with GCC 10
  2. see https://github.com/Reference-ScaLAPACK/scalapack/pull/26 and https://github.com/Reference-ScaLAPACK/scalapack/issues/21
  3. From 9c909f06cf51a3d00252323ce52aba46cc64ab41 Mon Sep 17 00:00:00 2001
  4. From: =?UTF-8?q?Tiziano=20M=C3=BCller?= <tiziano.mueller@chem.uzh.ch>
  5. Date: Thu, 25 Jun 2020 18:36:46 +0200
  6. Subject: [PATCH 1/2] fix argument mismatches in the SRC
  7. ---
  8. SRC/pclarf.f | 80 +++++++++++++++++-----------------
  9. SRC/pclarfc.f | 88 ++++++++++++++++++-------------------
  10. SRC/pclarz.f | 111 ++++++++++++++++++++++++-----------------------
  11. SRC/pclarzc.f | 115 +++++++++++++++++++++++++------------------------
  12. SRC/pclattrs.f | 55 +++++++++++------------
  13. SRC/pclawil.f | 53 +++++++++++------------
  14. SRC/pctrevc.f | 20 +++++----
  15. SRC/pdhseqr.f | 36 ++++++++--------
  16. SRC/pdlacon.f | 36 ++++++++--------
  17. SRC/pdlarf.f | 80 +++++++++++++++++-----------------
  18. SRC/pdlarz.f | 100 +++++++++++++++++++++---------------------
  19. SRC/pdlawil.f | 48 ++++++++++-----------
  20. SRC/pdstebz.f | 20 ++++-----
  21. SRC/pdtrord.f | 43 +++++++++++-------
  22. SRC/pdtrsen.f | 24 ++++++-----
  23. SRC/pshseqr.f | 36 ++++++++--------
  24. SRC/pslacon.f | 36 +++++++++-------
  25. SRC/pslarf.f | 80 +++++++++++++++++-----------------
  26. SRC/pslarz.f | 100 +++++++++++++++++++++---------------------
  27. SRC/pslawil.f | 50 +++++++++++----------
  28. SRC/psstebz.f | 20 ++++-----
  29. SRC/pstrord.f | 45 +++++++++++--------
  30. SRC/pstrsen.f | 22 ++++++----
  31. SRC/pzlarf.f | 80 +++++++++++++++++-----------------
  32. SRC/pzlarfc.f | 88 ++++++++++++++++++-------------------
  33. SRC/pzlarz.f | 103 +++++++++++++++++++++----------------------
  34. SRC/pzlarzc.f | 111 ++++++++++++++++++++++++-----------------------
  35. SRC/pzlattrs.f | 55 +++++++++++------------
  36. SRC/pzlawil.f | 49 +++++++++++----------
  37. SRC/pztrevc.f | 20 +++++----
  38. 30 files changed, 927 insertions(+), 877 deletions(-)
  39. diff --git a/SRC/pclarf.f b/SRC/pclarf.f
  40. index f941e46..371f710 100644
  41. --- a/SRC/pclarf.f
  42. +++ b/SRC/pclarf.f
  43. @@ -242,7 +242,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  44. $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
  45. $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
  46. $ NQ, RDEST
  47. - COMPLEX TAULOC
  48. + COMPLEX TAULOC( 1 )
  49. * ..
  50. * .. External Subroutines ..
  51. EXTERNAL BLACS_GRIDINFO, CCOPY, CGEBR2D, CGEBS2D,
  52. @@ -336,7 +336,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  53. *
  54. CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  55. $ TAU( IIV ), 1 )
  56. - TAULOC = TAU( IIV )
  57. + TAULOC( 1 ) = TAU( IIV )
  58. *
  59. ELSE
  60. *
  61. @@ -345,7 +345,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  62. *
  63. END IF
  64. *
  65. - IF( TAULOC.NE.ZERO ) THEN
  66. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  67. *
  68. * w := sub( C )' * v
  69. *
  70. @@ -363,8 +363,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  71. *
  72. * sub( C ) := sub( C ) - v * w'
  73. *
  74. - CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  75. - $ 1, C( IOFFC ), LDC )
  76. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  77. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  78. END IF
  79. *
  80. END IF
  81. @@ -379,9 +379,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  82. *
  83. IF( MYCOL.EQ.ICCOL ) THEN
  84. *
  85. - TAULOC = TAU( JJV )
  86. + TAULOC( 1 ) = TAU( JJV )
  87. *
  88. - IF( TAULOC.NE.ZERO ) THEN
  89. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  90. *
  91. * w := sub( C )' * v
  92. *
  93. @@ -398,7 +398,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  94. *
  95. * sub( C ) := sub( C ) - v * w'
  96. *
  97. - CALL CGERC( MP, NQ, -TAULOC, V( IOFFV ), 1,
  98. + CALL CGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
  99. $ WORK, 1, C( IOFFC ), LDC )
  100. END IF
  101. *
  102. @@ -421,9 +421,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  103. IPW = MP+1
  104. CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  105. $ IVCOL )
  106. - TAULOC = WORK( IPW )
  107. + TAULOC( 1 ) = WORK( IPW )
  108. *
  109. - IF( TAULOC.NE.ZERO ) THEN
  110. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  111. *
  112. * w := sub( C )' * v
  113. *
  114. @@ -441,7 +441,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  115. *
  116. * sub( C ) := sub( C ) - v * w'
  117. *
  118. - CALL CGERC( MP, NQ, -TAULOC, WORK, 1,
  119. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  120. $ WORK( IPW ), 1, C( IOFFC ), LDC )
  121. END IF
  122. *
  123. @@ -471,7 +471,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  124. *
  125. CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  126. $ TAU( IIV ), 1 )
  127. - TAULOC = TAU( IIV )
  128. + TAULOC( 1 ) = TAU( IIV )
  129. *
  130. ELSE
  131. *
  132. @@ -480,7 +480,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  133. *
  134. END IF
  135. *
  136. - IF( TAULOC.NE.ZERO ) THEN
  137. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  138. *
  139. * w := sub( C )' * v
  140. *
  141. @@ -500,8 +500,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  142. * sub( C ) := sub( C ) - v * w'
  143. *
  144. IF( IOFFC.GT.0 )
  145. - $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  146. - $ 1, C( IOFFC ), LDC )
  147. + $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  148. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  149. END IF
  150. *
  151. ELSE
  152. @@ -516,18 +516,18 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  153. WORK(IPW) = TAU( JJV )
  154. CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  155. $ WORK, IPW )
  156. - TAULOC = TAU( JJV )
  157. + TAULOC( 1 ) = TAU( JJV )
  158. *
  159. ELSE
  160. *
  161. IPW = MP+1
  162. CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  163. $ IPW, MYROW, IVCOL )
  164. - TAULOC = WORK( IPW )
  165. + TAULOC( 1 ) = WORK( IPW )
  166. *
  167. END IF
  168. *
  169. - IF( TAULOC.NE.ZERO ) THEN
  170. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  171. *
  172. * w := sub( C )' * v
  173. *
  174. @@ -547,8 +547,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  175. * sub( C ) := sub( C ) - v * w'
  176. *
  177. IF( IOFFC.GT.0 )
  178. - $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  179. - $ 1, C( IOFFC ), LDC )
  180. + $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  181. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  182. END IF
  183. *
  184. END IF
  185. @@ -577,9 +577,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  186. *
  187. IF( MYROW.EQ.ICROW ) THEN
  188. *
  189. - TAULOC = TAU( IIV )
  190. + TAULOC( 1 ) = TAU( IIV )
  191. *
  192. - IF( TAULOC.NE.ZERO ) THEN
  193. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  194. *
  195. * w := sub( C ) * v
  196. *
  197. @@ -597,7 +597,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  198. * sub( C ) := sub( C ) - w * v'
  199. *
  200. IF( IOFFV.GT.0 .AND. IOFFC.GT.0 )
  201. - $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1,
  202. + $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  203. $ V( IOFFV ), LDV, C( IOFFC ),
  204. $ LDC )
  205. END IF
  206. @@ -621,9 +621,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  207. IPW = NQ+1
  208. CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  209. $ MYCOL )
  210. - TAULOC = WORK( IPW )
  211. + TAULOC( 1 ) = WORK( IPW )
  212. *
  213. - IF( TAULOC.NE.ZERO ) THEN
  214. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  215. *
  216. * w := sub( C ) * v
  217. *
  218. @@ -641,8 +641,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  219. *
  220. * sub( C ) := sub( C ) - w * v'
  221. *
  222. - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1,
  223. - $ WORK, 1, C( IOFFC ), LDC )
  224. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ),
  225. + $ 1, WORK, 1, C( IOFFC ), LDC )
  226. END IF
  227. *
  228. END IF
  229. @@ -667,7 +667,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  230. *
  231. CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  232. $ TAU( JJV ), 1 )
  233. - TAULOC = TAU( JJV )
  234. + TAULOC( 1 ) = TAU( JJV )
  235. *
  236. ELSE
  237. *
  238. @@ -676,7 +676,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  239. *
  240. END IF
  241. *
  242. - IF( TAULOC.NE.ZERO ) THEN
  243. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  244. *
  245. * w := sub( C ) * v
  246. *
  247. @@ -694,8 +694,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  248. *
  249. * sub( C ) := sub( C ) - w * v'
  250. *
  251. - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  252. - $ 1, C( IOFFC ), LDC )
  253. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  254. + $ WORK, 1, C( IOFFC ), LDC )
  255. END IF
  256. *
  257. END IF
  258. @@ -720,18 +720,18 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  259. WORK(IPW) = TAU( IIV )
  260. CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  261. $ WORK, IPW )
  262. - TAULOC = TAU( IIV )
  263. + TAULOC( 1 ) = TAU( IIV )
  264. *
  265. ELSE
  266. *
  267. IPW = NQ+1
  268. CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  269. $ WORK, IPW, IVROW, MYCOL )
  270. - TAULOC = WORK( IPW )
  271. + TAULOC( 1 ) = WORK( IPW )
  272. *
  273. END IF
  274. *
  275. - IF( TAULOC.NE.ZERO ) THEN
  276. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  277. *
  278. * w := sub( C ) * v
  279. *
  280. @@ -750,8 +750,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  281. * sub( C ) := sub( C ) - w * v'
  282. *
  283. IF( IOFFC.GT.0 )
  284. - $ CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  285. - $ 1, C( IOFFC ), LDC )
  286. + $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  287. + $ WORK, 1, C( IOFFC ), LDC )
  288. END IF
  289. *
  290. ELSE
  291. @@ -770,7 +770,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  292. *
  293. CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  294. $ 1 )
  295. - TAULOC = TAU( JJV )
  296. + TAULOC( 1 ) = TAU( JJV )
  297. *
  298. ELSE
  299. *
  300. @@ -779,7 +779,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  301. *
  302. END IF
  303. *
  304. - IF( TAULOC.NE.ZERO ) THEN
  305. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  306. *
  307. * w := sub( C ) * v
  308. *
  309. @@ -797,8 +797,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  310. *
  311. * sub( C ) := sub( C ) - w * v'
  312. *
  313. - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
  314. - $ C( IOFFC ), LDC )
  315. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  316. + $ WORK, 1, C( IOFFC ), LDC )
  317. END IF
  318. *
  319. END IF
  320. diff --git a/SRC/pclarfc.f b/SRC/pclarfc.f
  321. index d6a2d3b..f84c493 100644
  322. --- a/SRC/pclarfc.f
  323. +++ b/SRC/pclarfc.f
  324. @@ -242,7 +242,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  325. $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
  326. $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
  327. $ NQ, RDEST
  328. - COMPLEX TAULOC
  329. + COMPLEX TAULOC( 1 )
  330. * ..
  331. * .. External Subroutines ..
  332. EXTERNAL BLACS_GRIDINFO, CCOPY, CGEBR2D, CGEBS2D,
  333. @@ -336,17 +336,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  334. *
  335. CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  336. $ TAU( IIV ), 1 )
  337. - TAULOC = CONJG( TAU( IIV ) )
  338. + TAULOC( 1 ) = CONJG( TAU( IIV ) )
  339. *
  340. ELSE
  341. *
  342. CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
  343. $ TAULOC, 1, IVROW, MYCOL )
  344. - TAULOC = CONJG( TAULOC )
  345. + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
  346. *
  347. END IF
  348. *
  349. - IF( TAULOC.NE.ZERO ) THEN
  350. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  351. *
  352. * w := sub( C )' * v
  353. *
  354. @@ -364,8 +364,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  355. *
  356. * sub( C ) := sub( C ) - v * w'
  357. *
  358. - CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  359. - $ 1, C( IOFFC ), LDC )
  360. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  361. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  362. END IF
  363. *
  364. END IF
  365. @@ -380,9 +380,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  366. *
  367. IF( MYCOL.EQ.ICCOL ) THEN
  368. *
  369. - TAULOC = CONJG( TAU( JJV ) )
  370. + TAULOC( 1 ) = CONJG( TAU( JJV ) )
  371. *
  372. - IF( TAULOC.NE.ZERO ) THEN
  373. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  374. *
  375. * w := sub( C )' * v
  376. *
  377. @@ -399,7 +399,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  378. *
  379. * sub( C ) := sub( C ) - v * w'
  380. *
  381. - CALL CGERC( MP, NQ, -TAULOC, V( IOFFV ), 1,
  382. + CALL CGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
  383. $ WORK, 1, C( IOFFC ), LDC )
  384. END IF
  385. *
  386. @@ -422,9 +422,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  387. IPW = MP+1
  388. CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  389. $ IVCOL )
  390. - TAULOC = CONJG( WORK( IPW ) )
  391. + TAULOC( 1 ) = CONJG( WORK( IPW ) )
  392. *
  393. - IF( TAULOC.NE.ZERO ) THEN
  394. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  395. *
  396. * w := sub( C )' * v
  397. *
  398. @@ -442,7 +442,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  399. *
  400. * sub( C ) := sub( C ) - v * w'
  401. *
  402. - CALL CGERC( MP, NQ, -TAULOC, WORK, 1,
  403. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  404. $ WORK( IPW ), 1, C( IOFFC ), LDC )
  405. END IF
  406. *
  407. @@ -472,17 +472,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  408. *
  409. CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  410. $ TAU( IIV ), 1 )
  411. - TAULOC = CONJG( TAU( IIV ) )
  412. + TAULOC( 1 ) = CONJG( TAU( IIV ) )
  413. *
  414. ELSE
  415. *
  416. CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
  417. $ 1, IVROW, MYCOL )
  418. - TAULOC = CONJG( TAULOC )
  419. + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
  420. *
  421. END IF
  422. *
  423. - IF( TAULOC.NE.ZERO ) THEN
  424. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  425. *
  426. * w := sub( C )' * v
  427. *
  428. @@ -500,8 +500,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  429. *
  430. * sub( C ) := sub( C ) - v * w'
  431. *
  432. - CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1,
  433. - $ C( IOFFC ), LDC )
  434. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  435. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  436. END IF
  437. *
  438. ELSE
  439. @@ -516,18 +516,18 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  440. WORK(IPW) = TAU( JJV )
  441. CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  442. $ WORK, IPW )
  443. - TAULOC = CONJG( TAU( JJV ) )
  444. + TAULOC( 1 ) = CONJG( TAU( JJV ) )
  445. *
  446. ELSE
  447. *
  448. IPW = MP+1
  449. CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  450. $ IPW, MYROW, IVCOL )
  451. - TAULOC = CONJG( WORK( IPW ) )
  452. + TAULOC( 1 ) = CONJG( WORK( IPW ) )
  453. *
  454. END IF
  455. *
  456. - IF( TAULOC.NE.ZERO ) THEN
  457. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  458. *
  459. * w := sub( C )' * v
  460. *
  461. @@ -545,8 +545,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  462. *
  463. * sub( C ) := sub( C ) - v * w'
  464. *
  465. - CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1,
  466. - $ C( IOFFC ), LDC )
  467. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  468. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  469. END IF
  470. *
  471. END IF
  472. @@ -575,9 +575,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  473. *
  474. IF( MYROW.EQ.ICROW ) THEN
  475. *
  476. - TAULOC = CONJG( TAU( IIV ) )
  477. + TAULOC( 1 ) = CONJG( TAU( IIV ) )
  478. *
  479. - IF( TAULOC.NE.ZERO ) THEN
  480. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  481. *
  482. * w := sub( C ) * v
  483. *
  484. @@ -594,7 +594,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  485. *
  486. * sub( C ) := sub( C ) - w * v'
  487. *
  488. - CALL CGERC( MP, NQ, -TAULOC, WORK, 1,
  489. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  490. $ V( IOFFV ), LDV, C( IOFFC ), LDC )
  491. END IF
  492. *
  493. @@ -617,9 +617,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  494. IPW = NQ+1
  495. CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  496. $ MYCOL )
  497. - TAULOC = CONJG( WORK( IPW ) )
  498. + TAULOC( 1 ) = CONJG( WORK( IPW ) )
  499. *
  500. - IF( TAULOC.NE.ZERO ) THEN
  501. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  502. *
  503. * w := sub( C ) * v
  504. *
  505. @@ -637,8 +637,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  506. *
  507. * sub( C ) := sub( C ) - w * v'
  508. *
  509. - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1,
  510. - $ WORK, 1, C( IOFFC ), LDC )
  511. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ),
  512. + $ 1, WORK, 1, C( IOFFC ), LDC )
  513. END IF
  514. *
  515. END IF
  516. @@ -663,17 +663,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  517. *
  518. CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  519. $ TAU( JJV ), 1 )
  520. - TAULOC = CONJG( TAU( JJV ) )
  521. + TAULOC( 1 ) = CONJG( TAU( JJV ) )
  522. *
  523. ELSE
  524. *
  525. CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
  526. $ 1, MYROW, IVCOL )
  527. - TAULOC = CONJG( TAULOC )
  528. + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
  529. *
  530. END IF
  531. *
  532. - IF( TAULOC.NE.ZERO ) THEN
  533. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  534. *
  535. * w := sub( C ) * v
  536. *
  537. @@ -691,8 +691,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  538. *
  539. * sub( C ) := sub( C ) - w * v'
  540. *
  541. - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  542. - $ 1, C( IOFFC ), LDC )
  543. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  544. + $ WORK, 1, C( IOFFC ), LDC )
  545. END IF
  546. *
  547. END IF
  548. @@ -716,18 +716,18 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  549. WORK(IPW) = TAU( IIV )
  550. CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  551. $ WORK, IPW )
  552. - TAULOC = CONJG( TAU( IIV ) )
  553. + TAULOC( 1 ) = CONJG( TAU( IIV ) )
  554. *
  555. ELSE
  556. *
  557. IPW = NQ+1
  558. CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  559. $ WORK, IPW, IVROW, MYCOL )
  560. - TAULOC = CONJG( WORK( IPW ) )
  561. + TAULOC( 1 ) = CONJG( WORK( IPW ) )
  562. *
  563. END IF
  564. *
  565. - IF( TAULOC.NE.ZERO ) THEN
  566. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  567. *
  568. * w := sub( C ) * v
  569. *
  570. @@ -745,8 +745,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  571. *
  572. * sub( C ) := sub( C ) - w * v'
  573. *
  574. - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
  575. - $ C( IOFFC ), LDC )
  576. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  577. + $ WORK, 1, C( IOFFC ), LDC )
  578. END IF
  579. *
  580. ELSE
  581. @@ -765,17 +765,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  582. *
  583. CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  584. $ 1 )
  585. - TAULOC = CONJG( TAU( JJV ) )
  586. + TAULOC( 1 ) = CONJG( TAU( JJV ) )
  587. *
  588. ELSE
  589. *
  590. CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1,
  591. $ MYROW, IVCOL )
  592. - TAULOC = CONJG( TAULOC )
  593. + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
  594. *
  595. END IF
  596. *
  597. - IF( TAULOC.NE.ZERO ) THEN
  598. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  599. *
  600. * w := sub( C ) * v
  601. *
  602. @@ -793,8 +793,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  603. *
  604. * sub( C ) := sub( C ) - w * v'
  605. *
  606. - CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
  607. - $ C( IOFFC ), LDC )
  608. + CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  609. + $ WORK, 1, C( IOFFC ), LDC )
  610. END IF
  611. *
  612. END IF
  613. diff --git a/SRC/pclarz.f b/SRC/pclarz.f
  614. index 9ba730c..673860a 100644
  615. --- a/SRC/pclarz.f
  616. +++ b/SRC/pclarz.f
  617. @@ -251,7 +251,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  618. $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
  619. $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
  620. $ NQC2, NQV, RDEST
  621. - COMPLEX TAULOC
  622. + COMPLEX TAULOC( 1 )
  623. * ..
  624. * .. External Subroutines ..
  625. EXTERNAL BLACS_GRIDINFO, CAXPY, CCOPY, CGEBR2D,
  626. @@ -370,7 +370,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  627. *
  628. CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  629. $ TAU( IIV ), 1 )
  630. - TAULOC = TAU( IIV )
  631. + TAULOC( 1 ) = TAU( IIV )
  632. *
  633. ELSE
  634. *
  635. @@ -379,7 +379,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  636. *
  637. END IF
  638. *
  639. - IF( TAULOC.NE.ZERO ) THEN
  640. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  641. *
  642. * w := sub( C )' * v
  643. *
  644. @@ -402,9 +402,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  645. * sub( C ) := sub( C ) - v * w'
  646. *
  647. IF( MYROW.EQ.ICROW1 )
  648. - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
  649. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  650. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  651. - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1,
  652. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  653. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  654. END IF
  655. *
  656. @@ -420,9 +420,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  657. *
  658. IF( MYCOL.EQ.ICCOL2 ) THEN
  659. *
  660. - TAULOC = TAU( JJV )
  661. + TAULOC( 1 ) = TAU( JJV )
  662. *
  663. - IF( TAULOC.NE.ZERO ) THEN
  664. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  665. *
  666. * w := sub( C )' * v
  667. *
  668. @@ -445,11 +445,11 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  669. * sub( C ) := sub( C ) - v * w'
  670. *
  671. IF( MYROW.EQ.ICROW1 )
  672. - $ CALL CAXPY( NQC2, -TAULOC, WORK,
  673. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK,
  674. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  675. $ LDC )
  676. - CALL CGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
  677. - $ WORK, 1, C( IOFFC2 ), LDC )
  678. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
  679. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  680. END IF
  681. *
  682. END IF
  683. @@ -471,9 +471,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  684. IPW = MPV+1
  685. CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  686. $ IVCOL )
  687. - TAULOC = WORK( IPW )
  688. + TAULOC( 1 ) = WORK( IPW )
  689. *
  690. - IF( TAULOC.NE.ZERO ) THEN
  691. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  692. *
  693. * w := sub( C )' * v
  694. *
  695. @@ -496,10 +496,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  696. * sub( C ) := sub( C ) - v * w'
  697. *
  698. IF( MYROW.EQ.ICROW1 )
  699. - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
  700. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  701. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  702. $ LDC )
  703. - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1,
  704. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  705. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  706. END IF
  707. *
  708. @@ -530,16 +530,16 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  709. *
  710. CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  711. $ TAU( IIV ), 1 )
  712. - TAULOC = TAU( IIV )
  713. + TAULOC( 1 ) = TAU( IIV )
  714. *
  715. ELSE
  716. *
  717. - CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
  718. - $ 1, IVROW, MYCOL )
  719. + CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
  720. + $ TAULOC( 1 ), 1, IVROW, MYCOL )
  721. *
  722. END IF
  723. *
  724. - IF( TAULOC.NE.ZERO ) THEN
  725. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  726. *
  727. * w := sub( C )' * v
  728. *
  729. @@ -562,10 +562,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  730. * sub( C ) := sub( C ) - v * w'
  731. *
  732. IF( MYROW.EQ.ICROW1 )
  733. - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
  734. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  735. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  736. - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  737. - $ 1, C( IOFFC2 ), LDC )
  738. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  739. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  740. END IF
  741. *
  742. ELSE
  743. @@ -580,18 +580,18 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  744. WORK( IPW ) = TAU( JJV )
  745. CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  746. $ WORK, IPW )
  747. - TAULOC = TAU( JJV )
  748. + TAULOC( 1 ) = TAU( JJV )
  749. *
  750. ELSE
  751. *
  752. IPW = MPV+1
  753. CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  754. $ IPW, MYROW, IVCOL )
  755. - TAULOC = WORK( IPW )
  756. + TAULOC( 1 ) = WORK( IPW )
  757. *
  758. END IF
  759. *
  760. - IF( TAULOC.NE.ZERO ) THEN
  761. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  762. *
  763. * w := sub( C )' * v
  764. *
  765. @@ -614,10 +614,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  766. * sub( C ) := sub( C ) - v * w'
  767. *
  768. IF( MYROW.EQ.ICROW1 )
  769. - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
  770. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  771. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  772. - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  773. - $ 1, C( IOFFC2 ), LDC )
  774. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  775. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  776. END IF
  777. *
  778. END IF
  779. @@ -646,9 +646,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  780. *
  781. IF( MYROW.EQ.ICROW2 ) THEN
  782. *
  783. - TAULOC = TAU( IIV )
  784. + TAULOC( 1 ) = TAU( IIV )
  785. *
  786. - IF( TAULOC.NE.ZERO ) THEN
  787. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  788. *
  789. * w := sub( C ) * v
  790. *
  791. @@ -669,13 +669,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  792. $ ICCOL2 )
  793. *
  794. IF( MYCOL.EQ.ICCOL1 )
  795. - $ CALL CAXPY( MPC2, -TAULOC, WORK, 1,
  796. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
  797. $ C( IOFFC1 ), 1 )
  798. *
  799. * sub( C ) := sub( C ) - w * v'
  800. *
  801. IF( MPC2.GT.0 .AND. NQV.GT.0 )
  802. - $ CALL CGERC( MPC2, NQV, -TAULOC, WORK, 1,
  803. + $ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
  804. $ V( IOFFV ), LDV, C( IOFFC2 ),
  805. $ LDC )
  806. END IF
  807. @@ -699,9 +699,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  808. IPW = NQV+1
  809. CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  810. $ MYCOL )
  811. - TAULOC = WORK( IPW )
  812. + TAULOC( 1 ) = WORK( IPW )
  813. *
  814. - IF( TAULOC.NE.ZERO ) THEN
  815. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  816. *
  817. * w := sub( C ) * v
  818. *
  819. @@ -720,13 +720,14 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  820. $ WORK( IPW ), MAX( 1, MPC2 ),
  821. $ RDEST, ICCOL2 )
  822. IF( MYCOL.EQ.ICCOL1 )
  823. - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  824. - $ C( IOFFC1 ), 1 )
  825. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
  826. + $ 1, C( IOFFC1 ), 1 )
  827. *
  828. * sub( C ) := sub( C ) - w * v'
  829. *
  830. - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  831. - $ WORK, 1, C( IOFFC2 ), LDC )
  832. + CALL CGERC( MPC2, NQV, -TAULOC( 1 ),
  833. + $ WORK( IPW ), 1, WORK, 1,
  834. + $ C( IOFFC2 ), LDC )
  835. END IF
  836. *
  837. END IF
  838. @@ -751,16 +752,16 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  839. *
  840. CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  841. $ TAU( JJV ), 1 )
  842. - TAULOC = TAU( JJV )
  843. + TAULOC( 1 ) = TAU( JJV )
  844. *
  845. ELSE
  846. *
  847. - CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
  848. - $ 1, MYROW, IVCOL )
  849. + CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1,
  850. + $ TAULOC( 1 ), 1, MYROW, IVCOL )
  851. *
  852. END IF
  853. *
  854. - IF( TAULOC.NE.ZERO ) THEN
  855. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  856. *
  857. * w := sub( C ) * v
  858. *
  859. @@ -779,13 +780,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  860. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  861. $ ICCOL2 )
  862. IF( MYCOL.EQ.ICCOL1 )
  863. - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  864. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  865. $ C( IOFFC1 ), 1 )
  866. *
  867. * sub( C ) := sub( C ) - w * v'
  868. *
  869. - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  870. - $ WORK, 1, C( IOFFC2 ), LDC )
  871. + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
  872. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  873. END IF
  874. *
  875. END IF
  876. @@ -809,18 +810,18 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  877. WORK( IPW ) = TAU( IIV )
  878. CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  879. $ WORK, IPW )
  880. - TAULOC = TAU( IIV )
  881. + TAULOC( 1 ) = TAU( IIV )
  882. *
  883. ELSE
  884. *
  885. IPW = NQV+1
  886. CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  887. $ WORK, IPW, IVROW, MYCOL )
  888. - TAULOC = WORK( IPW )
  889. + TAULOC( 1 ) = WORK( IPW )
  890. *
  891. END IF
  892. *
  893. - IF( TAULOC.NE.ZERO ) THEN
  894. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  895. *
  896. * w := sub( C ) * v
  897. *
  898. @@ -840,13 +841,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  899. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  900. $ ICCOL2 )
  901. IF( MYCOL.EQ.ICCOL1 )
  902. - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  903. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  904. $ C( IOFFC1 ), 1 )
  905. *
  906. * sub( C ) := sub( C ) - w * v'
  907. *
  908. - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  909. - $ 1, C( IOFFC2 ), LDC )
  910. + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  911. + $ WORK, 1, C( IOFFC2 ), LDC )
  912. END IF
  913. *
  914. ELSE
  915. @@ -865,7 +866,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  916. *
  917. CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  918. $ 1 )
  919. - TAULOC = TAU( JJV )
  920. + TAULOC( 1 ) = TAU( JJV )
  921. *
  922. ELSE
  923. *
  924. @@ -874,7 +875,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  925. *
  926. END IF
  927. *
  928. - IF( TAULOC.NE.ZERO ) THEN
  929. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  930. *
  931. * w := sub( C ) * v
  932. *
  933. @@ -893,13 +894,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  934. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  935. $ ICCOL2 )
  936. IF( MYCOL.EQ.ICCOL1 )
  937. - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  938. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  939. $ C( IOFFC1 ), 1 )
  940. *
  941. * sub( C ) := sub( C ) - w * v'
  942. *
  943. - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  944. - $ 1, C( IOFFC2 ), LDC )
  945. + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  946. + $ WORK, 1, C( IOFFC2 ), LDC )
  947. END IF
  948. *
  949. END IF
  950. diff --git a/SRC/pclarzc.f b/SRC/pclarzc.f
  951. index f1bc21e..b6d3b6d 100644
  952. --- a/SRC/pclarzc.f
  953. +++ b/SRC/pclarzc.f
  954. @@ -251,7 +251,7 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  955. $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
  956. $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
  957. $ NQC2, NQV, RDEST
  958. - COMPLEX TAULOC
  959. + COMPLEX TAULOC( 1 )
  960. * ..
  961. * .. External Subroutines ..
  962. EXTERNAL BLACS_GRIDINFO, CAXPY, CCOPY, CGEBR2D,
  963. @@ -370,17 +370,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  964. *
  965. CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  966. $ TAU( IIV ), 1 )
  967. - TAULOC = CONJG( TAU( IIV ) )
  968. + TAULOC( 1 ) = CONJG( TAU( IIV ) )
  969. *
  970. ELSE
  971. *
  972. CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
  973. $ TAULOC, 1, IVROW, MYCOL )
  974. - TAULOC = CONJG( TAULOC )
  975. + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
  976. *
  977. END IF
  978. *
  979. - IF( TAULOC.NE.ZERO ) THEN
  980. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  981. *
  982. * w := sub( C )' * v
  983. *
  984. @@ -403,9 +403,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  985. * sub( C ) := sub( C ) - v * w'
  986. *
  987. IF( MYROW.EQ.ICROW1 )
  988. - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
  989. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  990. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  991. - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1,
  992. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  993. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  994. END IF
  995. *
  996. @@ -421,9 +421,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  997. *
  998. IF( MYCOL.EQ.ICCOL2 ) THEN
  999. *
  1000. - TAULOC = CONJG( TAU( JJV ) )
  1001. + TAULOC( 1 ) = CONJG( TAU( JJV ) )
  1002. *
  1003. - IF( TAULOC.NE.ZERO ) THEN
  1004. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1005. *
  1006. * w := sub( C )' * v
  1007. *
  1008. @@ -446,11 +446,11 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1009. * sub( C ) := sub( C ) - v * w'
  1010. *
  1011. IF( MYROW.EQ.ICROW1 )
  1012. - $ CALL CAXPY( NQC2, -TAULOC, WORK,
  1013. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK,
  1014. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  1015. $ LDC )
  1016. - CALL CGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
  1017. - $ WORK, 1, C( IOFFC2 ), LDC )
  1018. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
  1019. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  1020. END IF
  1021. *
  1022. END IF
  1023. @@ -472,9 +472,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1024. IPW = MPV+1
  1025. CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  1026. $ IVCOL )
  1027. - TAULOC = CONJG( WORK( IPW ) )
  1028. + TAULOC( 1 ) = CONJG( WORK( IPW ) )
  1029. *
  1030. - IF( TAULOC.NE.ZERO ) THEN
  1031. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1032. *
  1033. * w := sub( C )' * v
  1034. *
  1035. @@ -497,10 +497,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1036. * sub( C ) := sub( C ) - v * w'
  1037. *
  1038. IF( MYROW.EQ.ICROW1 )
  1039. - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
  1040. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  1041. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  1042. $ LDC )
  1043. - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1,
  1044. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  1045. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  1046. END IF
  1047. *
  1048. @@ -531,17 +531,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1049. *
  1050. CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  1051. $ TAU( IIV ), 1 )
  1052. - TAULOC = CONJG( TAU( IIV ) )
  1053. + TAULOC( 1 ) = CONJG( TAU( IIV ) )
  1054. *
  1055. ELSE
  1056. *
  1057. CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
  1058. $ 1, IVROW, MYCOL )
  1059. - TAULOC = CONJG( TAULOC )
  1060. + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
  1061. *
  1062. END IF
  1063. *
  1064. - IF( TAULOC.NE.ZERO ) THEN
  1065. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1066. *
  1067. * w := sub( C )' * v
  1068. *
  1069. @@ -564,10 +564,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1070. * sub( C ) := sub( C ) - v * w'
  1071. *
  1072. IF( MYROW.EQ.ICROW1 )
  1073. - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
  1074. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  1075. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  1076. - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  1077. - $ 1, C( IOFFC2 ), LDC )
  1078. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  1079. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  1080. END IF
  1081. *
  1082. ELSE
  1083. @@ -582,18 +582,18 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1084. WORK( IPW ) = TAU( JJV )
  1085. CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  1086. $ WORK, IPW )
  1087. - TAULOC = CONJG( TAU( JJV ) )
  1088. + TAULOC( 1 ) = CONJG( TAU( JJV ) )
  1089. *
  1090. ELSE
  1091. *
  1092. IPW = MPV+1
  1093. CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  1094. $ IPW, MYROW, IVCOL )
  1095. - TAULOC = CONJG( WORK( IPW ) )
  1096. + TAULOC( 1 ) = CONJG( WORK( IPW ) )
  1097. *
  1098. END IF
  1099. *
  1100. - IF( TAULOC.NE.ZERO ) THEN
  1101. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1102. *
  1103. * w := sub( C )' * v
  1104. *
  1105. @@ -616,10 +616,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1106. * sub( C ) := sub( C ) - v * w'
  1107. *
  1108. IF( MYROW.EQ.ICROW1 )
  1109. - $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ),
  1110. + $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  1111. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  1112. - CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  1113. - $ 1, C( IOFFC2 ), LDC )
  1114. + CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  1115. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  1116. END IF
  1117. *
  1118. END IF
  1119. @@ -648,9 +648,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1120. *
  1121. IF( MYROW.EQ.ICROW2 ) THEN
  1122. *
  1123. - TAULOC = CONJG( TAU( IIV ) )
  1124. + TAULOC( 1 ) = CONJG( TAU( IIV ) )
  1125. *
  1126. - IF( TAULOC.NE.ZERO ) THEN
  1127. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1128. *
  1129. * w := sub( C ) * v
  1130. *
  1131. @@ -671,12 +671,12 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1132. $ ICCOL2 )
  1133. *
  1134. IF( MYCOL.EQ.ICCOL1 )
  1135. - $ CALL CAXPY( MPC2, -TAULOC, WORK, 1,
  1136. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
  1137. $ C( IOFFC1 ), 1 )
  1138. *
  1139. * sub( C ) := sub( C ) - w * v'
  1140. *
  1141. - CALL CGERC( MPC2, NQV, -TAULOC, WORK, 1,
  1142. + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
  1143. $ V( IOFFV ), LDV, C( IOFFC2 ), LDC )
  1144. END IF
  1145. *
  1146. @@ -699,9 +699,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1147. IPW = NQV+1
  1148. CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  1149. $ MYCOL )
  1150. - TAULOC = CONJG( WORK( IPW ) )
  1151. + TAULOC( 1 ) = CONJG( WORK( IPW ) )
  1152. *
  1153. - IF( TAULOC.NE.ZERO ) THEN
  1154. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1155. *
  1156. * w := sub( C ) * v
  1157. *
  1158. @@ -720,13 +720,14 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1159. $ WORK( IPW ), MAX( 1, MPC2 ),
  1160. $ RDEST, ICCOL2 )
  1161. IF( MYCOL.EQ.ICCOL1 )
  1162. - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  1163. - $ C( IOFFC1 ), 1 )
  1164. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
  1165. + $ 1, C( IOFFC1 ), 1 )
  1166. *
  1167. * sub( C ) := sub( C ) - w * v'
  1168. *
  1169. - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  1170. - $ WORK, 1, C( IOFFC2 ), LDC )
  1171. + CALL CGERC( MPC2, NQV, -TAULOC( 1 ),
  1172. + $ WORK( IPW ), 1, WORK, 1,
  1173. + $ C( IOFFC2 ), LDC )
  1174. END IF
  1175. *
  1176. END IF
  1177. @@ -751,17 +752,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1178. *
  1179. CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  1180. $ TAU( JJV ), 1 )
  1181. - TAULOC = CONJG( TAU( JJV ) )
  1182. + TAULOC( 1 ) = CONJG( TAU( JJV ) )
  1183. *
  1184. ELSE
  1185. *
  1186. CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
  1187. $ 1, MYROW, IVCOL )
  1188. - TAULOC = CONJG( TAULOC )
  1189. + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
  1190. *
  1191. END IF
  1192. *
  1193. - IF( TAULOC.NE.ZERO ) THEN
  1194. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1195. *
  1196. * w := sub( C ) * v
  1197. *
  1198. @@ -780,13 +781,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1199. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  1200. $ ICCOL2 )
  1201. IF( MYCOL.EQ.ICCOL1 )
  1202. - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  1203. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  1204. $ C( IOFFC1 ), 1 )
  1205. *
  1206. * sub( C ) := sub( C ) - w * v'
  1207. *
  1208. - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  1209. - $ WORK, 1, C( IOFFC2 ), LDC )
  1210. + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
  1211. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  1212. END IF
  1213. *
  1214. END IF
  1215. @@ -810,18 +811,18 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1216. WORK( IPW ) = TAU( IIV )
  1217. CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  1218. $ WORK, IPW )
  1219. - TAULOC = CONJG( TAU( IIV ) )
  1220. + TAULOC( 1 ) = CONJG( TAU( IIV ) )
  1221. *
  1222. ELSE
  1223. *
  1224. IPW = NQV+1
  1225. CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  1226. $ WORK, IPW, IVROW, MYCOL )
  1227. - TAULOC = CONJG( WORK( IPW ) )
  1228. + TAULOC( 1 ) = CONJG( WORK( IPW ) )
  1229. *
  1230. END IF
  1231. *
  1232. - IF( TAULOC.NE.ZERO ) THEN
  1233. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1234. *
  1235. * w := sub( C ) * v
  1236. *
  1237. @@ -841,13 +842,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1238. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  1239. $ ICCOL2 )
  1240. IF( MYCOL.EQ.ICCOL1 )
  1241. - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  1242. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  1243. $ C( IOFFC1 ), 1 )
  1244. *
  1245. * sub( C ) := sub( C ) - w * v'
  1246. *
  1247. - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  1248. - $ 1, C( IOFFC2 ), LDC )
  1249. + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  1250. + $ WORK, 1, C( IOFFC2 ), LDC )
  1251. END IF
  1252. *
  1253. ELSE
  1254. @@ -866,17 +867,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1255. *
  1256. CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  1257. $ 1 )
  1258. - TAULOC = CONJG( TAU( JJV ) )
  1259. + TAULOC( 1 ) = CONJG( TAU( JJV ) )
  1260. *
  1261. ELSE
  1262. *
  1263. - CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1,
  1264. - $ MYROW, IVCOL )
  1265. - TAULOC = CONJG( TAULOC )
  1266. + CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1,
  1267. + $ TAULOC( 1 ), 1, MYROW, IVCOL )
  1268. + TAULOC( 1 ) = CONJG( TAULOC( 1 ) )
  1269. *
  1270. END IF
  1271. *
  1272. - IF( TAULOC.NE.ZERO ) THEN
  1273. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1274. *
  1275. * w := sub( C ) * v
  1276. *
  1277. @@ -895,13 +896,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  1278. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  1279. $ ICCOL2 )
  1280. IF( MYCOL.EQ.ICCOL1 )
  1281. - $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  1282. + $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  1283. $ C( IOFFC1 ), 1 )
  1284. *
  1285. * sub( C ) := sub( C ) - w * v'
  1286. *
  1287. - CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  1288. - $ 1, C( IOFFC2 ), LDC )
  1289. + CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  1290. + $ WORK, 1, C( IOFFC2 ), LDC )
  1291. END IF
  1292. *
  1293. END IF
  1294. diff --git a/SRC/pclattrs.f b/SRC/pclattrs.f
  1295. index c744aea..0d12a8b 100644
  1296. --- a/SRC/pclattrs.f
  1297. +++ b/SRC/pclattrs.f
  1298. @@ -271,7 +271,8 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1299. $ JINC, JLAST, LDA, LDX, MB, MYCOL, MYROW, NB,
  1300. $ NPCOL, NPROW, RSRC
  1301. REAL BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL,
  1302. - $ XBND, XJ, XMAX
  1303. + $ XBND, XJ
  1304. + REAL XMAX( 1 )
  1305. COMPLEX CSUMJ, TJJS, USCAL, XJTMP, ZDUM
  1306. * ..
  1307. * .. External Functions ..
  1308. @@ -391,11 +392,11 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1309. * Compute a bound on the computed solution vector to see if the
  1310. * Level 2 PBLAS routine PCTRSV can be used.
  1311. *
  1312. - XMAX = ZERO
  1313. + XMAX( 1 ) = ZERO
  1314. CALL PCAMAX( N, ZDUM, IMAX, X, IX, JX, DESCX, 1 )
  1315. - XMAX = CABS2( ZDUM )
  1316. + XMAX( 1 ) = CABS2( ZDUM )
  1317. CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, -1, -1 )
  1318. - XBND = XMAX
  1319. + XBND = XMAX( 1 )
  1320. *
  1321. IF( NOTRAN ) THEN
  1322. *
  1323. @@ -590,16 +591,16 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1324. *
  1325. * Use a Level 1 PBLAS solve, scaling intermediate results.
  1326. *
  1327. - IF( XMAX.GT.BIGNUM*HALF ) THEN
  1328. + IF( XMAX( 1 ).GT.BIGNUM*HALF ) THEN
  1329. *
  1330. * Scale X so that its components are less than or equal to
  1331. * BIGNUM in absolute value.
  1332. *
  1333. - SCALE = ( BIGNUM*HALF ) / XMAX
  1334. + SCALE = ( BIGNUM*HALF ) / XMAX( 1 )
  1335. CALL PCSSCAL( N, SCALE, X, IX, JX, DESCX, 1 )
  1336. - XMAX = BIGNUM
  1337. + XMAX( 1 ) = BIGNUM
  1338. ELSE
  1339. - XMAX = XMAX*TWO
  1340. + XMAX( 1 ) = XMAX( 1 )*TWO
  1341. END IF
  1342. *
  1343. IF( NOTRAN ) THEN
  1344. @@ -651,7 +652,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1345. CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
  1346. XJTMP = XJTMP*REC
  1347. SCALE = SCALE*REC
  1348. - XMAX = XMAX*REC
  1349. + XMAX( 1 ) = XMAX( 1 )*REC
  1350. END IF
  1351. END IF
  1352. * X( J ) = CLADIV( X( J ), TJJS )
  1353. @@ -682,7 +683,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1354. CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
  1355. XJTMP = XJTMP*REC
  1356. SCALE = SCALE*REC
  1357. - XMAX = XMAX*REC
  1358. + XMAX( 1 ) = XMAX( 1 )*REC
  1359. END IF
  1360. * X( J ) = CLADIV( X( J ), TJJS )
  1361. * XJ = CABS1( X( J ) )
  1362. @@ -706,7 +707,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1363. XJTMP = CONE
  1364. XJ = ONE
  1365. SCALE = ZERO
  1366. - XMAX = ZERO
  1367. + XMAX( 1 ) = ZERO
  1368. END IF
  1369. 90 CONTINUE
  1370. *
  1371. @@ -715,7 +716,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1372. *
  1373. IF( XJ.GT.ONE ) THEN
  1374. REC = ONE / XJ
  1375. - IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
  1376. + IF( CNORM( J ).GT.( BIGNUM-XMAX( 1 ) )*REC ) THEN
  1377. *
  1378. * Scale x by 1/(2*abs(x(j))).
  1379. *
  1380. @@ -724,7 +725,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1381. XJTMP = XJTMP*REC
  1382. SCALE = SCALE*REC
  1383. END IF
  1384. - ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
  1385. + ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX( 1 ) ) ) THEN
  1386. *
  1387. * Scale x by 1/2.
  1388. *
  1389. @@ -743,7 +744,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1390. CALL PCAXPY( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1, X,
  1391. $ IX, JX, DESCX, 1 )
  1392. CALL PCAMAX( J-1, ZDUM, IMAX, X, IX, JX, DESCX, 1 )
  1393. - XMAX = CABS1( ZDUM )
  1394. + XMAX( 1 ) = CABS1( ZDUM )
  1395. CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1,
  1396. $ -1, -1 )
  1397. END IF
  1398. @@ -757,7 +758,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1399. CALL PCAXPY( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1,
  1400. $ X, IX+J, JX, DESCX, 1 )
  1401. CALL PCAMAX( N-J, ZDUM, I, X, IX+J, JX, DESCX, 1 )
  1402. - XMAX = CABS1( ZDUM )
  1403. + XMAX( 1 ) = CABS1( ZDUM )
  1404. CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1,
  1405. $ -1, -1 )
  1406. END IF
  1407. @@ -785,7 +786,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1408. END IF
  1409. XJ = CABS1( XJTMP )
  1410. USCAL = CMPLX( TSCAL )
  1411. - REC = ONE / MAX( XMAX, ONE )
  1412. + REC = ONE / MAX( XMAX( 1 ), ONE )
  1413. IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
  1414. *
  1415. * If x(j) could overflow, scale x by 1/(2*XMAX).
  1416. @@ -820,7 +821,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1417. CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
  1418. XJTMP = XJTMP*REC
  1419. SCALE = SCALE*REC
  1420. - XMAX = XMAX*REC
  1421. + XMAX( 1 ) = XMAX( 1 )*REC
  1422. END IF
  1423. END IF
  1424. *
  1425. @@ -924,7 +925,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1426. CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
  1427. XJTMP = XJTMP*REC
  1428. SCALE = SCALE*REC
  1429. - XMAX = XMAX*REC
  1430. + XMAX( 1 ) = XMAX( 1 )*REC
  1431. END IF
  1432. END IF
  1433. * X( J ) = CLADIV( X( J ), TJJS )
  1434. @@ -945,7 +946,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1435. CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
  1436. XJTMP = XJTMP*REC
  1437. SCALE = SCALE*REC
  1438. - XMAX = XMAX*REC
  1439. + XMAX( 1 ) = XMAX( 1 )*REC
  1440. END IF
  1441. * X( J ) = CLADIV( X( J ), TJJS )
  1442. XJTMP = CLADIV( XJTMP, TJJS )
  1443. @@ -966,7 +967,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1444. END IF
  1445. XJTMP = CONE
  1446. SCALE = ZERO
  1447. - XMAX = ZERO
  1448. + XMAX( 1 ) = ZERO
  1449. END IF
  1450. 110 CONTINUE
  1451. ELSE
  1452. @@ -981,7 +982,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1453. X( IROWX ) = XJTMP
  1454. END IF
  1455. END IF
  1456. - XMAX = MAX( XMAX, CABS1( XJTMP ) )
  1457. + XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) )
  1458. 120 CONTINUE
  1459. *
  1460. ELSE
  1461. @@ -1004,7 +1005,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1462. END IF
  1463. XJ = CABS1( XJTMP )
  1464. USCAL = TSCAL
  1465. - REC = ONE / MAX( XMAX, ONE )
  1466. + REC = ONE / MAX( XMAX( 1 ), ONE )
  1467. IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
  1468. *
  1469. * If x(j) could overflow, scale x by 1/(2*XMAX).
  1470. @@ -1039,7 +1040,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1471. CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
  1472. XJTMP = XJTMP*REC
  1473. SCALE = SCALE*REC
  1474. - XMAX = XMAX*REC
  1475. + XMAX( 1 ) = XMAX( 1 )*REC
  1476. END IF
  1477. END IF
  1478. *
  1479. @@ -1145,7 +1146,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1480. CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
  1481. XJTMP = XJTMP*REC
  1482. SCALE = SCALE*REC
  1483. - XMAX = XMAX*REC
  1484. + XMAX( 1 ) = XMAX( 1 )*REC
  1485. END IF
  1486. END IF
  1487. * X( J ) = CLADIV( X( J ), TJJS )
  1488. @@ -1164,7 +1165,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1489. CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 )
  1490. XJTMP = XJTMP*REC
  1491. SCALE = SCALE*REC
  1492. - XMAX = XMAX*REC
  1493. + XMAX( 1 ) = XMAX( 1 )*REC
  1494. END IF
  1495. * X( J ) = CLADIV( X( J ), TJJS )
  1496. XJTMP = CLADIV( XJTMP, TJJS )
  1497. @@ -1181,7 +1182,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1498. $ X( IROWX ) = CONE
  1499. XJTMP = CONE
  1500. SCALE = ZERO
  1501. - XMAX = ZERO
  1502. + XMAX( 1 ) = ZERO
  1503. END IF
  1504. 130 CONTINUE
  1505. ELSE
  1506. @@ -1194,7 +1195,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  1507. IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
  1508. $ X( IROWX ) = XJTMP
  1509. END IF
  1510. - XMAX = MAX( XMAX, CABS1( XJTMP ) )
  1511. + XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) )
  1512. 140 CONTINUE
  1513. END IF
  1514. SCALE = SCALE / TSCAL
  1515. diff --git a/SRC/pclawil.f b/SRC/pclawil.f
  1516. index 24a49b9..b33b3b1 100644
  1517. --- a/SRC/pclawil.f
  1518. +++ b/SRC/pclawil.f
  1519. @@ -124,11 +124,10 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  1520. $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT,
  1521. $ RSRC, UP
  1522. REAL S
  1523. - COMPLEX CDUM, H11, H12, H21, H22, H33S, H44S, V1, V2,
  1524. - $ V3
  1525. + COMPLEX CDUM, H22, H33S, H44S, V1, V2
  1526. * ..
  1527. * .. Local Arrays ..
  1528. - COMPLEX BUF( 4 )
  1529. + COMPLEX BUF( 4 ), V3( 1 ), H11( 1 ), H12( 1 ), H21( 1 )
  1530. * ..
  1531. * .. External Subroutines ..
  1532. EXTERNAL BLACS_GRIDINFO, INFOG2L, CGERV2D, CGESD2D
  1533. @@ -181,18 +180,18 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  1534. IF( NPCOL.GT.1 ) THEN
  1535. CALL CGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT )
  1536. ELSE
  1537. - V3 = A( ( ICOL-2 )*LDA+IROW )
  1538. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  1539. END IF
  1540. IF( NUM.GT.1 ) THEN
  1541. CALL CGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT )
  1542. - H11 = BUF( 1 )
  1543. - H21 = BUF( 2 )
  1544. - H12 = BUF( 3 )
  1545. + H11( 1 ) = BUF( 1 )
  1546. + H21( 1 ) = BUF( 2 )
  1547. + H12( 1 ) = BUF( 3 )
  1548. H22 = BUF( 4 )
  1549. ELSE
  1550. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  1551. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  1552. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  1553. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  1554. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  1555. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  1556. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  1557. END IF
  1558. END IF
  1559. @@ -223,22 +222,22 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  1560. CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
  1561. $ IROW, ICOL, RSRC, JSRC )
  1562. IF( NUM.GT.1 ) THEN
  1563. - CALL CGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT )
  1564. + CALL CGERV2D( CONTXT, 1, 1, H11( 1 ), 1, UP, LEFT )
  1565. ELSE
  1566. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  1567. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  1568. END IF
  1569. IF( NPROW.GT.1 ) THEN
  1570. CALL CGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL )
  1571. ELSE
  1572. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  1573. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  1574. END IF
  1575. IF( NPCOL.GT.1 ) THEN
  1576. - CALL CGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT )
  1577. + CALL CGERV2D( CONTXT, 1, 1, H21( 1 ), 1, MYROW, LEFT )
  1578. ELSE
  1579. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  1580. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  1581. END IF
  1582. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  1583. - V3 = A( ( ICOL-2 )*LDA+IROW )
  1584. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  1585. END IF
  1586. END IF
  1587. IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) )
  1588. @@ -247,24 +246,24 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  1589. IF( MODKM1.GT.1 ) THEN
  1590. CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
  1591. $ IROW, ICOL, RSRC, JSRC )
  1592. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  1593. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  1594. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  1595. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  1596. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  1597. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  1598. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  1599. - V3 = A( ( ICOL-2 )*LDA+IROW )
  1600. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  1601. END IF
  1602. *
  1603. - H44S = H44 - H11
  1604. - H33S = H33 - H11
  1605. - V1 = ( H33S*H44S-H43H34 ) / H21 + H12
  1606. - V2 = H22 - H11 - H33S - H44S
  1607. - S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3 )
  1608. + H44S = H44 - H11( 1 )
  1609. + H33S = H33 - H11( 1 )
  1610. + V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 )
  1611. + V2 = H22 - H11( 1 ) - H33S - H44S
  1612. + S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3( 1 ) )
  1613. V1 = V1 / S
  1614. V2 = V2 / S
  1615. - V3 = V3 / S
  1616. + V3( 1 ) = V3( 1 ) / S
  1617. V( 1 ) = V1
  1618. V( 2 ) = V2
  1619. - V( 3 ) = V3
  1620. + V( 3 ) = V3( 1 )
  1621. *
  1622. RETURN
  1623. *
  1624. diff --git a/SRC/pctrevc.f b/SRC/pctrevc.f
  1625. index d0a3043..bf6c52b 100644
  1626. --- a/SRC/pctrevc.f
  1627. +++ b/SRC/pctrevc.f
  1628. @@ -218,11 +218,12 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  1629. $ ITMP2, J, K, KI, LDT, LDVL, LDVR, LDW, MB,
  1630. $ MYCOL, MYROW, NB, NPCOL, NPROW, RSRC
  1631. REAL SELF
  1632. - REAL OVFL, REMAXD, SCALE, SMIN, SMLNUM, ULP, UNFL
  1633. + REAL OVFL, REMAXD, SCALE, SMLNUM, ULP, UNFL
  1634. COMPLEX CDUM, REMAXC, SHIFT
  1635. * ..
  1636. * .. Local Arrays ..
  1637. INTEGER DESCW( DLEN_ )
  1638. + REAL SMIN( 1 )
  1639. * ..
  1640. * .. External Functions ..
  1641. LOGICAL LSAME
  1642. @@ -355,13 +356,13 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  1643. $ GO TO 70
  1644. END IF
  1645. *
  1646. - SMIN = ZERO
  1647. + SMIN( 1 ) = ZERO
  1648. SHIFT = CZERO
  1649. CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL,
  1650. $ IROW, ICOL, ITMP1, ITMP2 )
  1651. IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
  1652. SHIFT = T( ( ICOL-1 )*LDT+IROW )
  1653. - SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
  1654. + SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
  1655. END IF
  1656. CALL SGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 )
  1657. CALL CGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 )
  1658. @@ -396,8 +397,9 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  1659. IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
  1660. T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -
  1661. $ SHIFT
  1662. - IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) THEN
  1663. - T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN )
  1664. + IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) )
  1665. + $ THEN
  1666. + T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN( 1 ) )
  1667. END IF
  1668. END IF
  1669. 50 CONTINUE
  1670. @@ -467,13 +469,13 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  1671. $ GO TO 110
  1672. END IF
  1673. *
  1674. - SMIN = ZERO
  1675. + SMIN( 1 ) = ZERO
  1676. SHIFT = CZERO
  1677. CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL,
  1678. $ IROW, ICOL, ITMP1, ITMP2 )
  1679. IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
  1680. SHIFT = T( ( ICOL-1 )*LDT+IROW )
  1681. - SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
  1682. + SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
  1683. END IF
  1684. CALL SGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 )
  1685. CALL CGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 )
  1686. @@ -507,8 +509,8 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  1687. IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
  1688. T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -
  1689. $ SHIFT
  1690. - IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN )
  1691. - $ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN )
  1692. + IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) )
  1693. + $ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN( 1 ) )
  1694. END IF
  1695. 90 CONTINUE
  1696. *
  1697. diff --git a/SRC/pdhseqr.f b/SRC/pdhseqr.f
  1698. index ffc3652..6e0f751 100644
  1699. --- a/SRC/pdhseqr.f
  1700. +++ b/SRC/pdhseqr.f
  1701. @@ -259,11 +259,12 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
  1702. $ HRSRC4, HCSRC4, LIWKOPT
  1703. LOGICAL INITZ, LQUERY, WANTT, WANTZ, PAIR, BORDER
  1704. DOUBLE PRECISION TMP1, TMP2, TMP3, TMP4, DUM1, DUM2, DUM3,
  1705. - $ DUM4, ELEM1, ELEM2, ELEM3, ELEM4,
  1706. + $ DUM4, ELEM1, ELEM4,
  1707. $ CS, SN, ELEM5, TMP, LWKOPT
  1708. * ..
  1709. * .. Local Arrays ..
  1710. INTEGER DESCH2( DLEN_ )
  1711. + DOUBLE PRECISION ELEM2( 1 ), ELEM3( 1 )
  1712. * ..
  1713. * .. External Functions ..
  1714. INTEGER PILAENVX, NUMROC, ICEIL
  1715. @@ -566,28 +567,28 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
  1716. IF( MYROW.EQ.HRSRC1 .AND. MYCOL.EQ.HCSRC1 ) THEN
  1717. ELEM1 = H((JLOC1-1)*LLDH+ILOC1)
  1718. IF( K.LT.N ) THEN
  1719. - ELEM3 = H((JLOC1-1)*LLDH+ILOC1+1)
  1720. + ELEM3( 1 ) = H((JLOC1-1)*LLDH+ILOC1+1)
  1721. ELSE
  1722. - ELEM3 = ZERO
  1723. + ELEM3( 1 ) = ZERO
  1724. END IF
  1725. - IF( ELEM3.NE.ZERO ) THEN
  1726. - ELEM2 = H((JLOC1)*LLDH+ILOC1)
  1727. + IF( ELEM3( 1 ).NE.ZERO ) THEN
  1728. + ELEM2( 1 ) = H((JLOC1)*LLDH+ILOC1)
  1729. ELEM4 = H((JLOC1)*LLDH+ILOC1+1)
  1730. - CALL DLANV2( ELEM1, ELEM2, ELEM3, ELEM4,
  1731. - $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ),
  1732. - $ SN, CS )
  1733. + CALL DLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ),
  1734. + $ ELEM4, WR( K ), WI( K ), WR( K+1 ),
  1735. + $ WI( K+1 ), SN, CS )
  1736. PAIR = .TRUE.
  1737. ELSE
  1738. IF( K.GT.1 ) THEN
  1739. TMP = H((JLOC1-2)*LLDH+ILOC1)
  1740. IF( TMP.NE.ZERO ) THEN
  1741. ELEM1 = H((JLOC1-2)*LLDH+ILOC1-1)
  1742. - ELEM2 = H((JLOC1-1)*LLDH+ILOC1-1)
  1743. - ELEM3 = H((JLOC1-2)*LLDH+ILOC1)
  1744. + ELEM2( 1 ) = H((JLOC1-1)*LLDH+ILOC1-1)
  1745. + ELEM3( 1 ) = H((JLOC1-2)*LLDH+ILOC1)
  1746. ELEM4 = H((JLOC1-1)*LLDH+ILOC1)
  1747. - CALL DLANV2( ELEM1, ELEM2, ELEM3,
  1748. - $ ELEM4, WR( K-1 ), WI( K-1 ),
  1749. - $ WR( K ), WI( K ), SN, CS )
  1750. + CALL DLANV2( ELEM1, ELEM2( 1 ),
  1751. + $ ELEM3( 1 ), ELEM4, WR( K-1 ),
  1752. + $ WI( K-1 ), WR( K ), WI( K ), SN, CS )
  1753. ELSE
  1754. WR( K ) = ELEM1
  1755. END IF
  1756. @@ -620,12 +621,12 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
  1757. CALL INFOG2L( K+1, K+1, DESCH, NPROW, NPCOL, MYROW, MYCOL,
  1758. $ ILOC4, JLOC4, HRSRC4, HCSRC4 )
  1759. IF( MYROW.EQ.HRSRC2 .AND. MYCOL.EQ.HCSRC2 ) THEN
  1760. - ELEM2 = H((JLOC2-1)*LLDH+ILOC2)
  1761. + ELEM2( 1 ) = H((JLOC2-1)*LLDH+ILOC2)
  1762. IF( HRSRC1.NE.HRSRC2 .OR. HCSRC1.NE.HCSRC2 )
  1763. $ CALL DGESD2D( ICTXT, 1, 1, ELEM2, 1, HRSRC1, HCSRC1)
  1764. END IF
  1765. IF( MYROW.EQ.HRSRC3 .AND. MYCOL.EQ.HCSRC3 ) THEN
  1766. - ELEM3 = H((JLOC3-1)*LLDH+ILOC3)
  1767. + ELEM3( 1 ) = H((JLOC3-1)*LLDH+ILOC3)
  1768. IF( HRSRC1.NE.HRSRC3 .OR. HCSRC1.NE.HCSRC3 )
  1769. $ CALL DGESD2D( ICTXT, 1, 1, ELEM3, 1, HRSRC1, HCSRC1)
  1770. END IF
  1771. @@ -651,8 +652,9 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
  1772. ELEM5 = WORK(2)
  1773. IF( ELEM5.EQ.ZERO ) THEN
  1774. IF( WR( K ).EQ.ZERO .AND. WI( K ).EQ.ZERO ) THEN
  1775. - CALL DLANV2( ELEM1, ELEM2, ELEM3, ELEM4, WR( K ),
  1776. - $ WI( K ), WR( K+1 ), WI( K+1 ), SN, CS )
  1777. + CALL DLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ELEM4,
  1778. + $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), SN,
  1779. + $ CS )
  1780. ELSEIF( WR( K+1 ).EQ.ZERO .AND. WI( K+1 ).EQ.ZERO )
  1781. $ THEN
  1782. WR( K+1 ) = ELEM4
  1783. diff --git a/SRC/pdlacon.f b/SRC/pdlacon.f
  1784. index b625d97..74b9eab 100644
  1785. --- a/SRC/pdlacon.f
  1786. +++ b/SRC/pdlacon.f
  1787. @@ -160,10 +160,10 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  1788. INTEGER I, ICTXT, IFLAG, IIVX, IMAXROW, IOFFVX, IROFF,
  1789. $ ITER, IVXCOL, IVXROW, J, JLAST, JJVX, JUMP,
  1790. $ K, MYCOL, MYROW, NP, NPCOL, NPROW
  1791. - DOUBLE PRECISION ALTSGN, ESTOLD, JLMAX, TEMP, XMAX
  1792. + DOUBLE PRECISION ALTSGN, ESTOLD, JLMAX, XMAX
  1793. * ..
  1794. * .. Local Arrays ..
  1795. - DOUBLE PRECISION WORK( 2 )
  1796. + DOUBLE PRECISION ESTWORK( 1 ), TEMP( 1 ), WORK( 2 )
  1797. * ..
  1798. * .. External Subroutines ..
  1799. EXTERNAL BLACS_GRIDINFO, DCOPY, DGEBR2D, DGEBS2D,
  1800. @@ -184,6 +184,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  1801. *
  1802. * Get grid parameters.
  1803. *
  1804. + ESTWORK( 1 ) = EST
  1805. ICTXT = DESCX( CTXT_ )
  1806. CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
  1807. *
  1808. @@ -215,21 +216,21 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  1809. IF( N.EQ.1 ) THEN
  1810. IF( MYROW.EQ.IVXROW ) THEN
  1811. V( IOFFVX ) = X( IOFFVX )
  1812. - EST = ABS( V( IOFFVX ) )
  1813. - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
  1814. + ESTWORK( 1 ) = ABS( V( IOFFVX ) )
  1815. + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
  1816. ELSE
  1817. - CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
  1818. + CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
  1819. $ IVXROW, MYCOL )
  1820. END IF
  1821. * ... QUIT
  1822. GO TO 150
  1823. END IF
  1824. - CALL PDASUM( N, EST, X, IX, JX, DESCX, 1 )
  1825. + CALL PDASUM( N, ESTWORK( 1 ), X, IX, JX, DESCX, 1 )
  1826. IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
  1827. IF( MYROW.EQ.IVXROW ) THEN
  1828. - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
  1829. + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
  1830. ELSE
  1831. - CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
  1832. + CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
  1833. $ IVXROW, MYCOL )
  1834. END IF
  1835. END IF
  1836. @@ -281,13 +282,13 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  1837. *
  1838. 70 CONTINUE
  1839. CALL DCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 )
  1840. - ESTOLD = EST
  1841. - CALL PDASUM( N, EST, V, IV, JV, DESCV, 1 )
  1842. + ESTOLD = ESTWORK( 1 )
  1843. + CALL PDASUM( N, ESTWORK( 1 ), V, IV, JV, DESCV, 1 )
  1844. IF( DESCV( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
  1845. IF( MYROW.EQ.IVXROW ) THEN
  1846. - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
  1847. + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
  1848. ELSE
  1849. - CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
  1850. + CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
  1851. $ IVXROW, MYCOL )
  1852. END IF
  1853. END IF
  1854. @@ -305,7 +306,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  1855. * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
  1856. * ALONG WITH IT, TEST FOR CYCLING.
  1857. *
  1858. - IF( IFLAG.EQ.0 .OR. EST.LE.ESTOLD )
  1859. + IF( IFLAG.EQ.0 .OR. ESTWORK( 1 ).LE.ESTOLD )
  1860. $ GO TO 120
  1861. *
  1862. DO 100 I = IOFFVX, IOFFVX+NP-1
  1863. @@ -361,7 +362,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  1864. * X HAS BEEN OVERWRITTEN BY A*X
  1865. *
  1866. 140 CONTINUE
  1867. - CALL PDASUM( N, TEMP, X, IX, JX, DESCX, 1 )
  1868. + CALL PDASUM( N, TEMP( 1 ), X, IX, JX, DESCX, 1 )
  1869. IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
  1870. IF( MYROW.EQ.IVXROW ) THEN
  1871. CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, TEMP, 1 )
  1872. @@ -370,15 +371,16 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  1873. $ IVXROW, MYCOL )
  1874. END IF
  1875. END IF
  1876. - TEMP = TWO*( TEMP / DBLE( 3*N ) )
  1877. - IF( TEMP.GT.EST ) THEN
  1878. + TEMP( 1 ) = TWO*( TEMP( 1 ) / DBLE( 3*N ) )
  1879. + IF( TEMP( 1 ).GT.ESTWORK( 1 ) ) THEN
  1880. CALL DCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 )
  1881. - EST = TEMP
  1882. + ESTWORK( 1 ) = TEMP( 1 )
  1883. END IF
  1884. *
  1885. 150 CONTINUE
  1886. KASE = 0
  1887. *
  1888. + EST = ESTWORK( 1 )
  1889. RETURN
  1890. *
  1891. * End of PDLACON
  1892. diff --git a/SRC/pdlarf.f b/SRC/pdlarf.f
  1893. index 29da1ac..41368d6 100644
  1894. --- a/SRC/pdlarf.f
  1895. +++ b/SRC/pdlarf.f
  1896. @@ -241,7 +241,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1897. $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
  1898. $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
  1899. $ NQ, RDEST
  1900. - DOUBLE PRECISION TAULOC
  1901. + DOUBLE PRECISION TAULOC( 1 )
  1902. * ..
  1903. * .. External Subroutines ..
  1904. EXTERNAL BLACS_GRIDINFO, DCOPY, DGEBR2D, DGEBS2D,
  1905. @@ -335,7 +335,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1906. *
  1907. CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  1908. $ TAU( IIV ), 1 )
  1909. - TAULOC = TAU( IIV )
  1910. + TAULOC( 1 ) = TAU( IIV )
  1911. *
  1912. ELSE
  1913. *
  1914. @@ -344,7 +344,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1915. *
  1916. END IF
  1917. *
  1918. - IF( TAULOC.NE.ZERO ) THEN
  1919. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1920. *
  1921. * w := sub( C )' * v
  1922. *
  1923. @@ -362,8 +362,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1924. *
  1925. * sub( C ) := sub( C ) - v * w'
  1926. *
  1927. - CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  1928. - $ 1, C( IOFFC ), LDC )
  1929. + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  1930. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  1931. END IF
  1932. *
  1933. END IF
  1934. @@ -378,9 +378,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1935. *
  1936. IF( MYCOL.EQ.ICCOL ) THEN
  1937. *
  1938. - TAULOC = TAU( JJV )
  1939. + TAULOC( 1 ) = TAU( JJV )
  1940. *
  1941. - IF( TAULOC.NE.ZERO ) THEN
  1942. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1943. *
  1944. * w := sub( C )' * v
  1945. *
  1946. @@ -397,8 +397,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1947. *
  1948. * sub( C ) := sub( C ) - v * w'
  1949. *
  1950. - CALL DGER( MP, NQ, -TAULOC, V( IOFFV ), 1, WORK,
  1951. - $ 1, C( IOFFC ), LDC )
  1952. + CALL DGER( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
  1953. + $ WORK, 1, C( IOFFC ), LDC )
  1954. END IF
  1955. *
  1956. END IF
  1957. @@ -420,9 +420,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1958. IPW = MP+1
  1959. CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  1960. $ IVCOL )
  1961. - TAULOC = WORK( IPW )
  1962. + TAULOC( 1 ) = WORK( IPW )
  1963. *
  1964. - IF( TAULOC.NE.ZERO ) THEN
  1965. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1966. *
  1967. * w := sub( C )' * v
  1968. *
  1969. @@ -440,7 +440,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1970. *
  1971. * sub( C ) := sub( C ) - v * w'
  1972. *
  1973. - CALL DGER( MP, NQ, -TAULOC, WORK, 1,
  1974. + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  1975. $ WORK( IPW ), 1, C( IOFFC ), LDC )
  1976. END IF
  1977. *
  1978. @@ -470,7 +470,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1979. *
  1980. CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  1981. $ TAU( IIV ), 1 )
  1982. - TAULOC = TAU( IIV )
  1983. + TAULOC( 1 ) = TAU( IIV )
  1984. *
  1985. ELSE
  1986. *
  1987. @@ -479,7 +479,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1988. *
  1989. END IF
  1990. *
  1991. - IF( TAULOC.NE.ZERO ) THEN
  1992. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  1993. *
  1994. * w := sub( C )' * v
  1995. *
  1996. @@ -499,8 +499,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  1997. * sub( C ) := sub( C ) - v * w'
  1998. *
  1999. IF( IOFFC.GT.0 )
  2000. - $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  2001. - $ 1, C( IOFFC ), LDC )
  2002. + $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  2003. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  2004. END IF
  2005. *
  2006. ELSE
  2007. @@ -515,18 +515,18 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2008. WORK(IPW) = TAU( JJV )
  2009. CALL DGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  2010. $ WORK, IPW )
  2011. - TAULOC = TAU( JJV )
  2012. + TAULOC( 1 ) = TAU( JJV )
  2013. *
  2014. ELSE
  2015. *
  2016. IPW = MP+1
  2017. CALL DGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  2018. $ IPW, MYROW, IVCOL )
  2019. - TAULOC = WORK( IPW )
  2020. + TAULOC( 1 ) = WORK( IPW )
  2021. *
  2022. END IF
  2023. *
  2024. - IF( TAULOC.NE.ZERO ) THEN
  2025. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2026. *
  2027. * w := sub( C )' * v
  2028. *
  2029. @@ -546,8 +546,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2030. * sub( C ) := sub( C ) - v * w'
  2031. *
  2032. IF( IOFFC.GT.0 )
  2033. - $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  2034. - $ 1, C( IOFFC ), LDC )
  2035. + $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  2036. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  2037. END IF
  2038. *
  2039. END IF
  2040. @@ -576,9 +576,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2041. *
  2042. IF( MYROW.EQ.ICROW ) THEN
  2043. *
  2044. - TAULOC = TAU( IIV )
  2045. + TAULOC( 1 ) = TAU( IIV )
  2046. *
  2047. - IF( TAULOC.NE.ZERO ) THEN
  2048. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2049. *
  2050. * w := sub( C ) * v
  2051. *
  2052. @@ -596,7 +596,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2053. * sub( C ) := sub( C ) - w * v'
  2054. *
  2055. IF( IOFFV.GT.0 .AND. IOFFC.GT.0 )
  2056. - $ CALL DGER( MP, NQ, -TAULOC, WORK, 1,
  2057. + $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  2058. $ V( IOFFV ), LDV, C( IOFFC ), LDC )
  2059. END IF
  2060. *
  2061. @@ -619,9 +619,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2062. IPW = NQ+1
  2063. CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  2064. $ MYCOL )
  2065. - TAULOC = WORK( IPW )
  2066. + TAULOC( 1 ) = WORK( IPW )
  2067. *
  2068. - IF( TAULOC.NE.ZERO ) THEN
  2069. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2070. *
  2071. * w := sub( C ) * v
  2072. *
  2073. @@ -639,7 +639,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2074. *
  2075. * sub( C ) := sub( C ) - w * v'
  2076. *
  2077. - CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1,
  2078. + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  2079. $ WORK, 1, C( IOFFC ), LDC )
  2080. END IF
  2081. *
  2082. @@ -665,7 +665,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2083. *
  2084. CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  2085. $ TAU( JJV ), 1 )
  2086. - TAULOC = TAU( JJV )
  2087. + TAULOC( 1 ) = TAU( JJV )
  2088. *
  2089. ELSE
  2090. *
  2091. @@ -674,7 +674,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2092. *
  2093. END IF
  2094. *
  2095. - IF( TAULOC.NE.ZERO ) THEN
  2096. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2097. *
  2098. * w := sub( C ) * v
  2099. *
  2100. @@ -692,8 +692,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2101. *
  2102. * sub( C ) := sub( C ) - w * v'
  2103. *
  2104. - CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  2105. - $ 1, C( IOFFC ), LDC )
  2106. + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  2107. + $ WORK, 1, C( IOFFC ), LDC )
  2108. END IF
  2109. *
  2110. END IF
  2111. @@ -718,18 +718,18 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2112. WORK(IPW) = TAU( IIV )
  2113. CALL DGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  2114. $ WORK, IPW )
  2115. - TAULOC = TAU( IIV )
  2116. + TAULOC( 1 ) = TAU( IIV )
  2117. *
  2118. ELSE
  2119. *
  2120. IPW = NQ+1
  2121. CALL DGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  2122. $ WORK, IPW, IVROW, MYCOL )
  2123. - TAULOC = WORK( IPW )
  2124. + TAULOC( 1 ) = WORK( IPW )
  2125. *
  2126. END IF
  2127. *
  2128. - IF( TAULOC.NE.ZERO ) THEN
  2129. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2130. *
  2131. * w := sub( C ) * v
  2132. *
  2133. @@ -748,8 +748,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2134. * sub( C ) := sub( C ) - w * v'
  2135. *
  2136. IF( IOFFC.GT.0 )
  2137. - $ CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  2138. - $ 1, C( IOFFC ), LDC )
  2139. + $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  2140. + $ WORK, 1, C( IOFFC ), LDC )
  2141. END IF
  2142. *
  2143. ELSE
  2144. @@ -768,7 +768,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2145. *
  2146. CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  2147. $ 1 )
  2148. - TAULOC = TAU( JJV )
  2149. + TAULOC( 1 ) = TAU( JJV )
  2150. *
  2151. ELSE
  2152. *
  2153. @@ -777,7 +777,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2154. *
  2155. END IF
  2156. *
  2157. - IF( TAULOC.NE.ZERO ) THEN
  2158. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2159. *
  2160. * w := sub( C ) * v
  2161. *
  2162. @@ -795,8 +795,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  2163. *
  2164. * sub( C ) := sub( C ) - w * v'
  2165. *
  2166. - CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
  2167. - $ C( IOFFC ), LDC )
  2168. + CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, WORK,
  2169. + $ 1, C( IOFFC ), LDC )
  2170. END IF
  2171. *
  2172. END IF
  2173. diff --git a/SRC/pdlarz.f b/SRC/pdlarz.f
  2174. index b91282c..f45c137 100644
  2175. --- a/SRC/pdlarz.f
  2176. +++ b/SRC/pdlarz.f
  2177. @@ -250,7 +250,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2178. $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
  2179. $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
  2180. $ NQC2, NQV, RDEST
  2181. - DOUBLE PRECISION TAULOC
  2182. + DOUBLE PRECISION TAULOC( 1 )
  2183. * ..
  2184. * .. External Subroutines ..
  2185. EXTERNAL BLACS_GRIDINFO, DAXPY, DCOPY, DGEBR2D,
  2186. @@ -369,7 +369,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2187. *
  2188. CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  2189. $ TAU( IIV ), 1 )
  2190. - TAULOC = TAU( IIV )
  2191. + TAULOC( 1 ) = TAU( IIV )
  2192. *
  2193. ELSE
  2194. *
  2195. @@ -378,7 +378,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2196. *
  2197. END IF
  2198. *
  2199. - IF( TAULOC.NE.ZERO ) THEN
  2200. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2201. *
  2202. * w := sub( C )' * v
  2203. *
  2204. @@ -401,9 +401,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2205. * sub( C ) := sub( C ) - v * w'
  2206. *
  2207. IF( MYROW.EQ.ICROW1 )
  2208. - $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ),
  2209. + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  2210. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  2211. - CALL DGER( MPV, NQC2, -TAULOC, WORK, 1,
  2212. + CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  2213. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  2214. END IF
  2215. *
  2216. @@ -419,9 +419,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2217. *
  2218. IF( MYCOL.EQ.ICCOL2 ) THEN
  2219. *
  2220. - TAULOC = TAU( JJV )
  2221. + TAULOC( 1 ) = TAU( JJV )
  2222. *
  2223. - IF( TAULOC.NE.ZERO ) THEN
  2224. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2225. *
  2226. * w := sub( C )' * v
  2227. *
  2228. @@ -444,11 +444,11 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2229. * sub( C ) := sub( C ) - v * w'
  2230. *
  2231. IF( MYROW.EQ.ICROW1 )
  2232. - $ CALL DAXPY( NQC2, -TAULOC, WORK,
  2233. + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK,
  2234. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  2235. $ LDC )
  2236. - CALL DGER( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
  2237. - $ WORK, 1, C( IOFFC2 ), LDC )
  2238. + CALL DGER( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
  2239. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  2240. END IF
  2241. *
  2242. END IF
  2243. @@ -470,9 +470,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2244. IPW = MPV+1
  2245. CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  2246. $ IVCOL )
  2247. - TAULOC = WORK( IPW )
  2248. + TAULOC( 1 ) = WORK( IPW )
  2249. *
  2250. - IF( TAULOC.NE.ZERO ) THEN
  2251. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2252. *
  2253. * w := sub( C )' * v
  2254. *
  2255. @@ -495,10 +495,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2256. * sub( C ) := sub( C ) - v * w'
  2257. *
  2258. IF( MYROW.EQ.ICROW1 )
  2259. - $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ),
  2260. + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  2261. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  2262. $ LDC )
  2263. - CALL DGER( MPV, NQC2, -TAULOC, WORK, 1,
  2264. + CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  2265. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  2266. END IF
  2267. *
  2268. @@ -529,7 +529,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2269. *
  2270. CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  2271. $ TAU( IIV ), 1 )
  2272. - TAULOC = TAU( IIV )
  2273. + TAULOC( 1 ) = TAU( IIV )
  2274. *
  2275. ELSE
  2276. *
  2277. @@ -538,7 +538,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2278. *
  2279. END IF
  2280. *
  2281. - IF( TAULOC.NE.ZERO ) THEN
  2282. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2283. *
  2284. * w := sub( C )' * v
  2285. *
  2286. @@ -561,10 +561,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2287. * sub( C ) := sub( C ) - v * w'
  2288. *
  2289. IF( MYROW.EQ.ICROW1 )
  2290. - $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ),
  2291. + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  2292. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  2293. - CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  2294. - $ 1, C( IOFFC2 ), LDC )
  2295. + CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  2296. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  2297. END IF
  2298. *
  2299. ELSE
  2300. @@ -579,18 +579,18 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2301. WORK( IPW ) = TAU( JJV )
  2302. CALL DGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  2303. $ WORK, IPW )
  2304. - TAULOC = TAU( JJV )
  2305. + TAULOC( 1 ) = TAU( JJV )
  2306. *
  2307. ELSE
  2308. *
  2309. IPW = MPV+1
  2310. CALL DGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  2311. $ IPW, MYROW, IVCOL )
  2312. - TAULOC = WORK( IPW )
  2313. + TAULOC( 1 ) = WORK( IPW )
  2314. *
  2315. END IF
  2316. *
  2317. - IF( TAULOC.NE.ZERO ) THEN
  2318. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2319. *
  2320. * w := sub( C )' * v
  2321. *
  2322. @@ -613,10 +613,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2323. * sub( C ) := sub( C ) - v * w'
  2324. *
  2325. IF( MYROW.EQ.ICROW1 )
  2326. - $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ),
  2327. + $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  2328. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  2329. - CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  2330. - $ 1, C( IOFFC2 ), LDC )
  2331. + CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  2332. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  2333. END IF
  2334. *
  2335. END IF
  2336. @@ -645,9 +645,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2337. *
  2338. IF( MYROW.EQ.ICROW2 ) THEN
  2339. *
  2340. - TAULOC = TAU( IIV )
  2341. + TAULOC( 1 ) = TAU( IIV )
  2342. *
  2343. - IF( TAULOC.NE.ZERO ) THEN
  2344. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2345. *
  2346. * w := sub( C ) * v
  2347. *
  2348. @@ -668,13 +668,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2349. $ ICCOL2 )
  2350. *
  2351. IF( MYCOL.EQ.ICCOL1 )
  2352. - $ CALL DAXPY( MPC2, -TAULOC, WORK, 1,
  2353. + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
  2354. $ C( IOFFC1 ), 1 )
  2355. *
  2356. * sub( C ) := sub( C ) - w * v'
  2357. *
  2358. IF( MPC2.GT.0 .AND. NQV.GT.0 )
  2359. - $ CALL DGER( MPC2, NQV, -TAULOC, WORK, 1,
  2360. + $ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
  2361. $ V( IOFFV ), LDV, C( IOFFC2 ),
  2362. $ LDC )
  2363. END IF
  2364. @@ -698,9 +698,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2365. IPW = NQV+1
  2366. CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  2367. $ MYCOL )
  2368. - TAULOC = WORK( IPW )
  2369. + TAULOC( 1 ) = WORK( IPW )
  2370. *
  2371. - IF( TAULOC.NE.ZERO ) THEN
  2372. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2373. *
  2374. * w := sub( C ) * v
  2375. *
  2376. @@ -719,13 +719,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2377. $ WORK( IPW ), MAX( 1, MPC2 ),
  2378. $ RDEST, ICCOL2 )
  2379. IF( MYCOL.EQ.ICCOL1 )
  2380. - $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  2381. - $ C( IOFFC1 ), 1 )
  2382. + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
  2383. + $ 1, C( IOFFC1 ), 1 )
  2384. *
  2385. * sub( C ) := sub( C ) - w * v'
  2386. *
  2387. - CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  2388. - $ WORK, 1, C( IOFFC2 ), LDC )
  2389. + CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
  2390. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  2391. END IF
  2392. *
  2393. END IF
  2394. @@ -750,7 +750,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2395. *
  2396. CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  2397. $ TAU( JJV ), 1 )
  2398. - TAULOC = TAU( JJV )
  2399. + TAULOC( 1 ) = TAU( JJV )
  2400. *
  2401. ELSE
  2402. *
  2403. @@ -759,7 +759,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2404. *
  2405. END IF
  2406. *
  2407. - IF( TAULOC.NE.ZERO ) THEN
  2408. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2409. *
  2410. * w := sub( C ) * v
  2411. *
  2412. @@ -778,12 +778,12 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2413. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  2414. $ ICCOL2 )
  2415. IF( MYCOL.EQ.ICCOL1 )
  2416. - $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  2417. + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  2418. $ C( IOFFC1 ), 1 )
  2419. *
  2420. * sub( C ) := sub( C ) - w * v'
  2421. *
  2422. - CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  2423. + CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  2424. $ WORK, 1, C( IOFFC2 ), LDC )
  2425. END IF
  2426. *
  2427. @@ -808,18 +808,18 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2428. WORK( IPW ) = TAU( IIV )
  2429. CALL DGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  2430. $ WORK, IPW )
  2431. - TAULOC = TAU( IIV )
  2432. + TAULOC( 1 ) = TAU( IIV )
  2433. *
  2434. ELSE
  2435. *
  2436. IPW = NQV+1
  2437. CALL DGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  2438. $ WORK, IPW, IVROW, MYCOL )
  2439. - TAULOC = WORK( IPW )
  2440. + TAULOC( 1 ) = WORK( IPW )
  2441. *
  2442. END IF
  2443. *
  2444. - IF( TAULOC.NE.ZERO ) THEN
  2445. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2446. *
  2447. * w := sub( C ) * v
  2448. *
  2449. @@ -839,13 +839,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2450. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  2451. $ ICCOL2 )
  2452. IF( MYCOL.EQ.ICCOL1 )
  2453. - $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  2454. + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  2455. $ C( IOFFC1 ), 1 )
  2456. *
  2457. * sub( C ) := sub( C ) - w * v'
  2458. *
  2459. - CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  2460. - $ 1, C( IOFFC2 ), LDC )
  2461. + CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  2462. + $ WORK, 1, C( IOFFC2 ), LDC )
  2463. END IF
  2464. *
  2465. ELSE
  2466. @@ -864,7 +864,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2467. *
  2468. CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  2469. $ 1 )
  2470. - TAULOC = TAU( JJV )
  2471. + TAULOC( 1 ) = TAU( JJV )
  2472. *
  2473. ELSE
  2474. *
  2475. @@ -873,7 +873,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2476. *
  2477. END IF
  2478. *
  2479. - IF( TAULOC.NE.ZERO ) THEN
  2480. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  2481. *
  2482. * w := sub( C ) * v
  2483. *
  2484. @@ -892,13 +892,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  2485. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  2486. $ ICCOL2 )
  2487. IF( MYCOL.EQ.ICCOL1 )
  2488. - $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  2489. + $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  2490. $ C( IOFFC1 ), 1 )
  2491. *
  2492. * sub( C ) := sub( C ) - w * v'
  2493. *
  2494. - CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  2495. - $ 1, C( IOFFC2 ), LDC )
  2496. + CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  2497. + $ WORK, 1, C( IOFFC2 ), LDC )
  2498. END IF
  2499. *
  2500. END IF
  2501. diff --git a/SRC/pdlawil.f b/SRC/pdlawil.f
  2502. index 90a4d74..e8bc3a0 100644
  2503. --- a/SRC/pdlawil.f
  2504. +++ b/SRC/pdlawil.f
  2505. @@ -120,10 +120,10 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  2506. INTEGER CONTXT, DOWN, HBL, ICOL, IROW, JSRC, LDA, LEFT,
  2507. $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT,
  2508. $ RSRC, UP
  2509. - DOUBLE PRECISION H11, H12, H21, H22, H33S, H44S, S, V1, V2, V3
  2510. + DOUBLE PRECISION H22, H33S, H44S, S, V1, V2
  2511. * ..
  2512. * .. Local Arrays ..
  2513. - DOUBLE PRECISION BUF( 4 )
  2514. + DOUBLE PRECISION BUF( 4 ), H11( 1 ), H12( 1 ), H21( 1 ), V3( 1 )
  2515. * ..
  2516. * .. External Subroutines ..
  2517. EXTERNAL BLACS_GRIDINFO, DGERV2D, DGESD2D, INFOG2L
  2518. @@ -170,18 +170,18 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  2519. IF( NPCOL.GT.1 ) THEN
  2520. CALL DGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT )
  2521. ELSE
  2522. - V3 = A( ( ICOL-2 )*LDA+IROW )
  2523. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  2524. END IF
  2525. IF( NUM.GT.1 ) THEN
  2526. CALL DGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT )
  2527. - H11 = BUF( 1 )
  2528. - H21 = BUF( 2 )
  2529. - H12 = BUF( 3 )
  2530. + H11( 1 ) = BUF( 1 )
  2531. + H21( 1 ) = BUF( 2 )
  2532. + H12( 1 ) = BUF( 3 )
  2533. H22 = BUF( 4 )
  2534. ELSE
  2535. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  2536. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  2537. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  2538. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  2539. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  2540. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  2541. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  2542. END IF
  2543. END IF
  2544. @@ -214,20 +214,20 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  2545. IF( NUM.GT.1 ) THEN
  2546. CALL DGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT )
  2547. ELSE
  2548. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  2549. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  2550. END IF
  2551. IF( NPROW.GT.1 ) THEN
  2552. CALL DGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL )
  2553. ELSE
  2554. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  2555. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  2556. END IF
  2557. IF( NPCOL.GT.1 ) THEN
  2558. CALL DGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT )
  2559. ELSE
  2560. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  2561. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  2562. END IF
  2563. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  2564. - V3 = A( ( ICOL-2 )*LDA+IROW )
  2565. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  2566. END IF
  2567. END IF
  2568. IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) )
  2569. @@ -236,24 +236,24 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  2570. IF( MODKM1.GT.1 ) THEN
  2571. CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
  2572. $ IROW, ICOL, RSRC, JSRC )
  2573. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  2574. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  2575. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  2576. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  2577. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  2578. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  2579. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  2580. - V3 = A( ( ICOL-2 )*LDA+IROW )
  2581. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  2582. END IF
  2583. *
  2584. - H44S = H44 - H11
  2585. - H33S = H33 - H11
  2586. - V1 = ( H33S*H44S-H43H34 ) / H21 + H12
  2587. - V2 = H22 - H11 - H33S - H44S
  2588. - S = ABS( V1 ) + ABS( V2 ) + ABS( V3 )
  2589. + H44S = H44 - H11( 1 )
  2590. + H33S = H33 - H11( 1 )
  2591. + V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 )
  2592. + V2 = H22 - H11( 1 ) - H33S - H44S
  2593. + S = ABS( V1 ) + ABS( V2 ) + ABS( V3( 1 ) )
  2594. V1 = V1 / S
  2595. V2 = V2 / S
  2596. - V3 = V3 / S
  2597. + V3( 1 ) = V3( 1 ) / S
  2598. V( 1 ) = V1
  2599. V( 2 ) = V2
  2600. - V( 3 ) = V3
  2601. + V( 3 ) = V3( 1 )
  2602. *
  2603. RETURN
  2604. *
  2605. diff --git a/SRC/pdstebz.f b/SRC/pdstebz.f
  2606. index e7006f9..bf4dacc 100644
  2607. --- a/SRC/pdstebz.f
  2608. +++ b/SRC/pdstebz.f
  2609. @@ -246,14 +246,14 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU,
  2610. $ ITMP2, J, JB, K, LAST, LEXTRA, LREQ, MYCOL,
  2611. $ MYROW, NALPHA, NBETA, NCMP, NEIGINT, NEXT, NGL,
  2612. $ NGLOB, NGU, NINT, NPCOL, NPROW, OFFSET,
  2613. - $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF,
  2614. - $ TORECV
  2615. + $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF
  2616. DOUBLE PRECISION ALPHA, ATOLI, BETA, BNORM, DRECV, DSEND, GL,
  2617. $ GU, INITVL, INITVU, LSAVE, MID, PIVMIN, RELTOL,
  2618. $ SAFEMN, TMP1, TMP2, TNORM, ULP
  2619. * ..
  2620. * .. Local Arrays ..
  2621. INTEGER IDUM( 5, 2 )
  2622. + INTEGER TORECV( 1, 1 )
  2623. * ..
  2624. * .. Executable Statements ..
  2625. * This is just to keep ftnchek happy
  2626. @@ -784,14 +784,14 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU,
  2627. ELSE
  2628. CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', 1, 1, TORECV, 1, 0,
  2629. $ I-1 )
  2630. - IF( TORECV.NE.0 ) THEN
  2631. - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, IWORK,
  2632. - $ TORECV, 0, I-1 )
  2633. - CALL DGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, WORK,
  2634. - $ TORECV, 0, I-1 )
  2635. - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1,
  2636. - $ IWORK( N+1 ), TORECV, 0, I-1 )
  2637. - DO 120 J = 1, TORECV
  2638. + IF( TORECV( 1, 1 ).NE.0 ) THEN
  2639. + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
  2640. + $ IWORK, TORECV( 1, 1 ), 0, I-1 )
  2641. + CALL DGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
  2642. + $ WORK, TORECV( 1, 1 ), 0, I-1 )
  2643. + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
  2644. + $ IWORK( N+1 ), TORECV( 1, 1 ), 0, I-1 )
  2645. + DO 120 J = 1, TORECV( 1, 1 )
  2646. W( IWORK( J ) ) = WORK( J )
  2647. IBLOCK( IWORK( J ) ) = IWORK( N+J )
  2648. 120 CONTINUE
  2649. diff --git a/SRC/pdtrord.f b/SRC/pdtrord.f
  2650. index 1f37d8e..3870574 100644
  2651. --- a/SRC/pdtrord.f
  2652. +++ b/SRC/pdtrord.f
  2653. @@ -328,12 +328,13 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  2654. $ EAST, WEST, ILOC4, SOUTH, NORTH, INDXS,
  2655. $ ITT, JTT, ILEN, DLEN, INDXE, TRSRC1, TCSRC1,
  2656. $ TRSRC2, TCSRC2, ILOS, DIR, TLIHI, TLILO, TLSEL,
  2657. - $ ROUND, LAST, WIN0S, WIN0E, WINE, MMAX, MMIN
  2658. + $ ROUND, LAST, WIN0S, WIN0E, WINE
  2659. DOUBLE PRECISION ELEM, ELEM1, ELEM2, ELEM3, ELEM4, SN, CS, TMP,
  2660. $ ELEM5
  2661. * ..
  2662. * .. Local Arrays ..
  2663. - INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 )
  2664. + INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ), MMAX( 1 ),
  2665. + $ MMIN( 1 ), INFODUM( 1 )
  2666. * ..
  2667. * .. External Functions ..
  2668. LOGICAL LSAME
  2669. @@ -483,16 +484,16 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  2670. END IF
  2671. IF( SELECT(K).NE.0 ) M = M + 1
  2672. 10 CONTINUE
  2673. - MMAX = M
  2674. - MMIN = M
  2675. + MMAX( 1 ) = M
  2676. + MMIN( 1 ) = M
  2677. IF( NPROCS.GT.1 )
  2678. $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1,
  2679. $ -1, -1, -1, -1 )
  2680. IF( NPROCS.GT.1 )
  2681. $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1,
  2682. $ -1, -1, -1, -1 )
  2683. - IF( MMAX.GT.MMIN ) THEN
  2684. - M = MMAX
  2685. + IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN
  2686. + M = MMAX( 1 )
  2687. IF( NPROCS.GT.1 )
  2688. $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, SELECT, N,
  2689. $ -1, -1, -1, -1, -1 )
  2690. @@ -520,9 +521,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  2691. *
  2692. * Global maximum on info.
  2693. *
  2694. - IF( NPROCS.GT.1 )
  2695. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1,
  2696. + IF( NPROCS.GT.1 ) THEN
  2697. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, -1,
  2698. $ -1, -1 )
  2699. + INFO = INFODUM( 1 )
  2700. + END IF
  2701. *
  2702. * Return if some argument is incorrect.
  2703. *
  2704. @@ -1576,9 +1579,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  2705. * experienced a failure in the reordering.
  2706. *
  2707. MYIERR = IERR
  2708. - IF( NPROCS.GT.1 )
  2709. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1,
  2710. + IF( NPROCS.GT.1 ) THEN
  2711. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
  2712. $ -1, -1, -1, -1 )
  2713. + IERR = INFODUM( 1 )
  2714. + END IF
  2715. *
  2716. IF( IERR.NE.0 ) THEN
  2717. *
  2718. @@ -1586,9 +1591,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  2719. * to swap.
  2720. *
  2721. IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1)
  2722. - IF( NPROCS.GT.1 )
  2723. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1,
  2724. + IF( NPROCS.GT.1 ) THEN
  2725. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
  2726. $ -1, -1, -1, -1 )
  2727. + INFO = INFODUM( 1 )
  2728. + END IF
  2729. GO TO 300
  2730. END IF
  2731. *
  2732. @@ -3245,9 +3252,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  2733. * experienced a failure in the reordering.
  2734. *
  2735. MYIERR = IERR
  2736. - IF( NPROCS.GT.1 )
  2737. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1,
  2738. + IF( NPROCS.GT.1 ) THEN
  2739. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
  2740. $ -1, -1, -1, -1 )
  2741. + IERR = INFODUM( 1 )
  2742. + END IF
  2743. *
  2744. IF( IERR.NE.0 ) THEN
  2745. *
  2746. @@ -3255,9 +3264,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  2747. * to swap.
  2748. *
  2749. IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1)
  2750. - IF( NPROCS.GT.1 )
  2751. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1,
  2752. + IF( NPROCS.GT.1 ) THEN
  2753. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
  2754. $ -1, -1, -1, -1 )
  2755. + IERR = INFODUM( 1 )
  2756. + END IF
  2757. GO TO 300
  2758. END IF
  2759. *
  2760. diff --git a/SRC/pdtrsen.f b/SRC/pdtrsen.f
  2761. index 78c5599..c65ea91 100644
  2762. --- a/SRC/pdtrsen.f
  2763. +++ b/SRC/pdtrsen.f
  2764. @@ -354,13 +354,15 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
  2765. LOGICAL LQUERY, WANTBH, WANTQ, WANTS, WANTSP
  2766. INTEGER ICOFFT12, ICTXT, IDUM1, IDUM2, IERR, ILOC1,
  2767. $ IPW1, ITER, ITT, JLOC1, JTT, K, LIWMIN, LLDT,
  2768. - $ LLDQ, LWMIN, MMAX, MMIN, MYROW, MYCOL, N1, N2,
  2769. + $ LLDQ, LWMIN, MYROW, MYCOL, N1, N2,
  2770. $ NB, NOEXSY, NPCOL, NPROCS, NPROW, SPACE,
  2771. $ T12ROWS, T12COLS, TCOLS, TCSRC, TROWS, TRSRC,
  2772. $ WRK1, IWRK1, WRK2, IWRK2, WRK3, IWRK3
  2773. - DOUBLE PRECISION DPDUM1, ELEM, EST, SCALE, RNORM
  2774. + DOUBLE PRECISION ELEM, EST, SCALE, RNORM
  2775. * .. Local Arrays ..
  2776. - INTEGER DESCT12( DLEN_ ), MBNB2( 2 )
  2777. + INTEGER DESCT12( DLEN_ ), MBNB2( 2 ), MMAX( 1 ),
  2778. + $ MMIN( 1 )
  2779. + DOUBLE PRECISION DPDUM1( 1 )
  2780. * ..
  2781. * .. External Functions ..
  2782. LOGICAL LSAME
  2783. @@ -521,16 +523,16 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
  2784. END IF
  2785. IF( SELECT(K) ) M = M + 1
  2786. 10 CONTINUE
  2787. - MMAX = M
  2788. - MMIN = M
  2789. + MMAX( 1 ) = M
  2790. + MMIN( 1 ) = M
  2791. IF( NPROCS.GT.1 )
  2792. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1,
  2793. - $ -1, -1, -1, -1 )
  2794. + $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX( 1 ), 1,
  2795. + $ -1, -1, -1, -1, -1 )
  2796. IF( NPROCS.GT.1 )
  2797. - $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1,
  2798. - $ -1, -1, -1, -1 )
  2799. - IF( MMAX.GT.MMIN ) THEN
  2800. - M = MMAX
  2801. + $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN( 1 ), 1,
  2802. + $ -1, -1, -1, -1, -1 )
  2803. + IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN
  2804. + M = MMAX( 1 )
  2805. IF( NPROCS.GT.1 )
  2806. $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, IWORK, N,
  2807. $ -1, -1, -1, -1, -1 )
  2808. diff --git a/SRC/pshseqr.f b/SRC/pshseqr.f
  2809. index 10eb24a..e8ecea9 100644
  2810. --- a/SRC/pshseqr.f
  2811. +++ b/SRC/pshseqr.f
  2812. @@ -259,11 +259,12 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
  2813. $ HRSRC4, HCSRC4, LIWKOPT
  2814. LOGICAL INITZ, LQUERY, WANTT, WANTZ, PAIR, BORDER
  2815. REAL TMP1, TMP2, TMP3, TMP4, DUM1, DUM2, DUM3,
  2816. - $ DUM4, ELEM1, ELEM2, ELEM3, ELEM4,
  2817. + $ DUM4, ELEM1, ELEM4,
  2818. $ CS, SN, ELEM5, TMP, LWKOPT
  2819. * ..
  2820. * .. Local Arrays ..
  2821. INTEGER DESCH2( DLEN_ )
  2822. + REAL ELEM2( 1 ), ELEM3( 1 )
  2823. * ..
  2824. * .. External Functions ..
  2825. INTEGER PILAENVX, NUMROC, ICEIL
  2826. @@ -566,28 +567,28 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
  2827. IF( MYROW.EQ.HRSRC1 .AND. MYCOL.EQ.HCSRC1 ) THEN
  2828. ELEM1 = H((JLOC1-1)*LLDH+ILOC1)
  2829. IF( K.LT.N ) THEN
  2830. - ELEM3 = H((JLOC1-1)*LLDH+ILOC1+1)
  2831. + ELEM3( 1 ) = H((JLOC1-1)*LLDH+ILOC1+1)
  2832. ELSE
  2833. - ELEM3 = ZERO
  2834. + ELEM3( 1 ) = ZERO
  2835. END IF
  2836. - IF( ELEM3.NE.ZERO ) THEN
  2837. - ELEM2 = H((JLOC1)*LLDH+ILOC1)
  2838. + IF( ELEM3( 1 ).NE.ZERO ) THEN
  2839. + ELEM2( 1 ) = H((JLOC1)*LLDH+ILOC1)
  2840. ELEM4 = H((JLOC1)*LLDH+ILOC1+1)
  2841. - CALL SLANV2( ELEM1, ELEM2, ELEM3, ELEM4,
  2842. - $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ),
  2843. - $ SN, CS )
  2844. + CALL SLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ),
  2845. + $ ELEM4, WR( K ), WI( K ), WR( K+1 ),
  2846. + $ WI( K+1 ), SN, CS )
  2847. PAIR = .TRUE.
  2848. ELSE
  2849. IF( K.GT.1 ) THEN
  2850. TMP = H((JLOC1-2)*LLDH+ILOC1)
  2851. IF( TMP.NE.ZERO ) THEN
  2852. ELEM1 = H((JLOC1-2)*LLDH+ILOC1-1)
  2853. - ELEM2 = H((JLOC1-1)*LLDH+ILOC1-1)
  2854. - ELEM3 = H((JLOC1-2)*LLDH+ILOC1)
  2855. + ELEM2( 1 ) = H((JLOC1-1)*LLDH+ILOC1-1)
  2856. + ELEM3( 1 ) = H((JLOC1-2)*LLDH+ILOC1)
  2857. ELEM4 = H((JLOC1-1)*LLDH+ILOC1)
  2858. - CALL SLANV2( ELEM1, ELEM2, ELEM3,
  2859. - $ ELEM4, WR( K-1 ), WI( K-1 ),
  2860. - $ WR( K ), WI( K ), SN, CS )
  2861. + CALL SLANV2( ELEM1, ELEM2( 1 ),
  2862. + $ ELEM3( 1 ), ELEM4, WR( K-1 ),
  2863. + $ WI( K-1 ), WR( K ), WI( K ), SN, CS )
  2864. ELSE
  2865. WR( K ) = ELEM1
  2866. END IF
  2867. @@ -620,12 +621,12 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
  2868. CALL INFOG2L( K+1, K+1, DESCH, NPROW, NPCOL, MYROW, MYCOL,
  2869. $ ILOC4, JLOC4, HRSRC4, HCSRC4 )
  2870. IF( MYROW.EQ.HRSRC2 .AND. MYCOL.EQ.HCSRC2 ) THEN
  2871. - ELEM2 = H((JLOC2-1)*LLDH+ILOC2)
  2872. + ELEM2( 1 ) = H((JLOC2-1)*LLDH+ILOC2)
  2873. IF( HRSRC1.NE.HRSRC2 .OR. HCSRC1.NE.HCSRC2 )
  2874. $ CALL SGESD2D( ICTXT, 1, 1, ELEM2, 1, HRSRC1, HCSRC1)
  2875. END IF
  2876. IF( MYROW.EQ.HRSRC3 .AND. MYCOL.EQ.HCSRC3 ) THEN
  2877. - ELEM3 = H((JLOC3-1)*LLDH+ILOC3)
  2878. + ELEM3( 1 ) = H((JLOC3-1)*LLDH+ILOC3)
  2879. IF( HRSRC1.NE.HRSRC3 .OR. HCSRC1.NE.HCSRC3 )
  2880. $ CALL SGESD2D( ICTXT, 1, 1, ELEM3, 1, HRSRC1, HCSRC1)
  2881. END IF
  2882. @@ -651,8 +652,9 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z,
  2883. ELEM5 = WORK(2)
  2884. IF( ELEM5.EQ.ZERO ) THEN
  2885. IF( WR( K ).EQ.ZERO .AND. WI( K ).EQ.ZERO ) THEN
  2886. - CALL SLANV2( ELEM1, ELEM2, ELEM3, ELEM4, WR( K ),
  2887. - $ WI( K ), WR( K+1 ), WI( K+1 ), SN, CS )
  2888. + CALL SLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ELEM4,
  2889. + $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), SN,
  2890. + $ CS )
  2891. ELSEIF( WR( K+1 ).EQ.ZERO .AND. WI( K+1 ).EQ.ZERO )
  2892. $ THEN
  2893. WR( K+1 ) = ELEM4
  2894. diff --git a/SRC/pslacon.f b/SRC/pslacon.f
  2895. index 20d27ff..673bf1a 100644
  2896. --- a/SRC/pslacon.f
  2897. +++ b/SRC/pslacon.f
  2898. @@ -160,10 +160,12 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  2899. INTEGER I, ICTXT, IFLAG, IIVX, IMAXROW, IOFFVX, IROFF,
  2900. $ ITER, IVXCOL, IVXROW, J, JLAST, JJVX, JUMP,
  2901. $ K, MYCOL, MYROW, NP, NPCOL, NPROW
  2902. - REAL ALTSGN, ESTOLD, JLMAX, TEMP, XMAX
  2903. + REAL ALTSGN, ESTOLD, JLMAX, XMAX
  2904. * ..
  2905. * .. Local Arrays ..
  2906. REAL WORK( 2 )
  2907. + REAL ESTWORK( 1 )
  2908. + REAL TEMP( 1 )
  2909. * ..
  2910. * .. External Subroutines ..
  2911. EXTERNAL BLACS_GRIDINFO, IGSUM2D, INFOG2L, PSAMAX,
  2912. @@ -184,6 +186,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  2913. *
  2914. * Get grid parameters.
  2915. *
  2916. + ESTWORK( 1 ) = EST
  2917. ICTXT = DESCX( CTXT_ )
  2918. CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
  2919. *
  2920. @@ -215,21 +218,21 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  2921. IF( N.EQ.1 ) THEN
  2922. IF( MYROW.EQ.IVXROW ) THEN
  2923. V( IOFFVX ) = X( IOFFVX )
  2924. - EST = ABS( V( IOFFVX ) )
  2925. - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
  2926. + ESTWORK( 1 ) = ABS( V( IOFFVX ) )
  2927. + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
  2928. ELSE
  2929. - CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
  2930. + CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
  2931. $ IVXROW, MYCOL )
  2932. END IF
  2933. * ... QUIT
  2934. GO TO 150
  2935. END IF
  2936. - CALL PSASUM( N, EST, X, IX, JX, DESCX, 1 )
  2937. + CALL PSASUM( N, ESTWORK( 1 ), X, IX, JX, DESCX, 1 )
  2938. IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
  2939. IF( MYROW.EQ.IVXROW ) THEN
  2940. - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
  2941. + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
  2942. ELSE
  2943. - CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
  2944. + CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
  2945. $ IVXROW, MYCOL )
  2946. END IF
  2947. END IF
  2948. @@ -281,13 +284,13 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  2949. *
  2950. 70 CONTINUE
  2951. CALL SCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 )
  2952. - ESTOLD = EST
  2953. - CALL PSASUM( N, EST, V, IV, JV, DESCV, 1 )
  2954. + ESTOLD = ESTWORK( 1 )
  2955. + CALL PSASUM( N, ESTWORK( 1 ), V, IV, JV, DESCV, 1 )
  2956. IF( DESCV( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
  2957. IF( MYROW.EQ.IVXROW ) THEN
  2958. - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 )
  2959. + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 )
  2960. ELSE
  2961. - CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1,
  2962. + CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1,
  2963. $ IVXROW, MYCOL )
  2964. END IF
  2965. END IF
  2966. @@ -305,7 +308,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  2967. * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
  2968. * ALONG WITH IT, TEST FOR CYCLING.
  2969. *
  2970. - IF( IFLAG.EQ.0 .OR. EST.LE.ESTOLD )
  2971. + IF( IFLAG.EQ.0 .OR. ESTWORK( 1 ).LE.ESTOLD )
  2972. $ GO TO 120
  2973. *
  2974. DO 100 I = IOFFVX, IOFFVX+NP-1
  2975. @@ -361,7 +364,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  2976. * X HAS BEEN OVERWRITTEN BY A*X
  2977. *
  2978. 140 CONTINUE
  2979. - CALL PSASUM( N, TEMP, X, IX, JX, DESCX, 1 )
  2980. + CALL PSASUM( N, TEMP( 1 ), X, IX, JX, DESCX, 1 )
  2981. IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN
  2982. IF( MYROW.EQ.IVXROW ) THEN
  2983. CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, TEMP, 1 )
  2984. @@ -370,15 +373,16 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN,
  2985. $ IVXROW, MYCOL )
  2986. END IF
  2987. END IF
  2988. - TEMP = TWO*( TEMP / REAL( 3*N ) )
  2989. - IF( TEMP.GT.EST ) THEN
  2990. + TEMP( 1 ) = TWO*( TEMP( 1 ) / REAL( 3*N ) )
  2991. + IF( TEMP( 1 ).GT.ESTWORK( 1 ) ) THEN
  2992. CALL SCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 )
  2993. - EST = TEMP
  2994. + ESTWORK( 1 ) = TEMP( 1 )
  2995. END IF
  2996. *
  2997. 150 CONTINUE
  2998. KASE = 0
  2999. *
  3000. + EST = ESTWORK( 1 )
  3001. RETURN
  3002. *
  3003. * End of PSLACON
  3004. diff --git a/SRC/pslarf.f b/SRC/pslarf.f
  3005. index c1d3a15..39de0ed 100644
  3006. --- a/SRC/pslarf.f
  3007. +++ b/SRC/pslarf.f
  3008. @@ -241,7 +241,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3009. $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
  3010. $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
  3011. $ NQ, RDEST
  3012. - REAL TAULOC
  3013. + REAL TAULOC( 1 )
  3014. * ..
  3015. * .. External Subroutines ..
  3016. EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBSTRNV,
  3017. @@ -335,7 +335,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3018. *
  3019. CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  3020. $ TAU( IIV ), 1 )
  3021. - TAULOC = TAU( IIV )
  3022. + TAULOC( 1 ) = TAU( IIV )
  3023. *
  3024. ELSE
  3025. *
  3026. @@ -344,7 +344,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3027. *
  3028. END IF
  3029. *
  3030. - IF( TAULOC.NE.ZERO ) THEN
  3031. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3032. *
  3033. * w := sub( C )' * v
  3034. *
  3035. @@ -362,8 +362,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3036. *
  3037. * sub( C ) := sub( C ) - v * w'
  3038. *
  3039. - CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  3040. - $ 1, C( IOFFC ), LDC )
  3041. + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  3042. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  3043. END IF
  3044. *
  3045. END IF
  3046. @@ -378,9 +378,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3047. *
  3048. IF( MYCOL.EQ.ICCOL ) THEN
  3049. *
  3050. - TAULOC = TAU( JJV )
  3051. + TAULOC( 1 ) = TAU( JJV )
  3052. *
  3053. - IF( TAULOC.NE.ZERO ) THEN
  3054. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3055. *
  3056. * w := sub( C )' * v
  3057. *
  3058. @@ -397,8 +397,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3059. *
  3060. * sub( C ) := sub( C ) - v * w'
  3061. *
  3062. - CALL SGER( MP, NQ, -TAULOC, V( IOFFV ), 1, WORK,
  3063. - $ 1, C( IOFFC ), LDC )
  3064. + CALL SGER( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
  3065. + $ WORK, 1, C( IOFFC ), LDC )
  3066. END IF
  3067. *
  3068. END IF
  3069. @@ -420,9 +420,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3070. IPW = MP+1
  3071. CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  3072. $ IVCOL )
  3073. - TAULOC = WORK( IPW )
  3074. + TAULOC( 1 ) = WORK( IPW )
  3075. *
  3076. - IF( TAULOC.NE.ZERO ) THEN
  3077. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3078. *
  3079. * w := sub( C )' * v
  3080. *
  3081. @@ -440,7 +440,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3082. *
  3083. * sub( C ) := sub( C ) - v * w'
  3084. *
  3085. - CALL SGER( MP, NQ, -TAULOC, WORK, 1,
  3086. + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  3087. $ WORK( IPW ), 1, C( IOFFC ), LDC )
  3088. END IF
  3089. *
  3090. @@ -470,7 +470,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3091. *
  3092. CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  3093. $ TAU( IIV ), 1 )
  3094. - TAULOC = TAU( IIV )
  3095. + TAULOC( 1 ) = TAU( IIV )
  3096. *
  3097. ELSE
  3098. *
  3099. @@ -479,7 +479,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3100. *
  3101. END IF
  3102. *
  3103. - IF( TAULOC.NE.ZERO ) THEN
  3104. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3105. *
  3106. * w := sub( C )' * v
  3107. *
  3108. @@ -499,8 +499,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3109. * sub( C ) := sub( C ) - v * w'
  3110. *
  3111. IF( IOFFC.GT.0 )
  3112. - $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  3113. - $ 1, C( IOFFC ), LDC )
  3114. + $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  3115. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  3116. END IF
  3117. *
  3118. ELSE
  3119. @@ -515,18 +515,18 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3120. WORK(IPW) = TAU( JJV )
  3121. CALL SGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  3122. $ WORK, IPW )
  3123. - TAULOC = TAU( JJV )
  3124. + TAULOC( 1 ) = TAU( JJV )
  3125. *
  3126. ELSE
  3127. *
  3128. IPW = MP+1
  3129. CALL SGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  3130. $ IPW, MYROW, IVCOL )
  3131. - TAULOC = WORK( IPW )
  3132. + TAULOC( 1 ) = WORK( IPW )
  3133. *
  3134. END IF
  3135. *
  3136. - IF( TAULOC.NE.ZERO ) THEN
  3137. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3138. *
  3139. * w := sub( C )' * v
  3140. *
  3141. @@ -546,8 +546,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3142. * sub( C ) := sub( C ) - v * w'
  3143. *
  3144. IF( IOFFC.GT.0 )
  3145. - $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  3146. - $ 1, C( IOFFC ), LDC )
  3147. + $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  3148. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  3149. END IF
  3150. *
  3151. END IF
  3152. @@ -576,9 +576,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3153. *
  3154. IF( MYROW.EQ.ICROW ) THEN
  3155. *
  3156. - TAULOC = TAU( IIV )
  3157. + TAULOC( 1 ) = TAU( IIV )
  3158. *
  3159. - IF( TAULOC.NE.ZERO ) THEN
  3160. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3161. *
  3162. * w := sub( C ) * v
  3163. *
  3164. @@ -596,7 +596,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3165. * sub( C ) := sub( C ) - w * v'
  3166. *
  3167. IF( IOFFV.GT.0 .AND. IOFFC.GT.0 )
  3168. - $ CALL SGER( MP, NQ, -TAULOC, WORK, 1,
  3169. + $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1,
  3170. $ V( IOFFV ), LDV, C( IOFFC ), LDC )
  3171. END IF
  3172. *
  3173. @@ -619,9 +619,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3174. IPW = NQ+1
  3175. CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  3176. $ MYCOL )
  3177. - TAULOC = WORK( IPW )
  3178. + TAULOC( 1 ) = WORK( IPW )
  3179. *
  3180. - IF( TAULOC.NE.ZERO ) THEN
  3181. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3182. *
  3183. * w := sub( C ) * v
  3184. *
  3185. @@ -639,7 +639,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3186. *
  3187. * sub( C ) := sub( C ) - w * v'
  3188. *
  3189. - CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1,
  3190. + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  3191. $ WORK, 1, C( IOFFC ), LDC )
  3192. END IF
  3193. *
  3194. @@ -665,7 +665,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3195. *
  3196. CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  3197. $ TAU( JJV ), 1 )
  3198. - TAULOC = TAU( JJV )
  3199. + TAULOC( 1 ) = TAU( JJV )
  3200. *
  3201. ELSE
  3202. *
  3203. @@ -674,7 +674,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3204. *
  3205. END IF
  3206. *
  3207. - IF( TAULOC.NE.ZERO ) THEN
  3208. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3209. *
  3210. * w := sub( C ) * v
  3211. *
  3212. @@ -692,8 +692,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3213. *
  3214. * sub( C ) := sub( C ) - w * v'
  3215. *
  3216. - CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  3217. - $ 1, C( IOFFC ), LDC )
  3218. + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1
  3219. + $ , WORK, 1, C( IOFFC ), LDC )
  3220. END IF
  3221. *
  3222. END IF
  3223. @@ -718,18 +718,18 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3224. WORK(IPW) = TAU( IIV )
  3225. CALL SGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  3226. $ WORK, IPW )
  3227. - TAULOC = TAU( IIV )
  3228. + TAULOC( 1 ) = TAU( IIV )
  3229. *
  3230. ELSE
  3231. *
  3232. IPW = NQ+1
  3233. CALL SGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  3234. $ WORK, IPW, IVROW, MYCOL )
  3235. - TAULOC = WORK( IPW )
  3236. + TAULOC( 1 ) = WORK( IPW )
  3237. *
  3238. END IF
  3239. *
  3240. - IF( TAULOC.NE.ZERO ) THEN
  3241. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3242. *
  3243. * w := sub( C ) * v
  3244. *
  3245. @@ -748,8 +748,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3246. * sub( C ) := sub( C ) - w * v'
  3247. *
  3248. IF( IOFFC.GT.0 )
  3249. - $ CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  3250. - $ 1, C( IOFFC ), LDC )
  3251. + $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  3252. + $ WORK, 1, C( IOFFC ), LDC )
  3253. END IF
  3254. *
  3255. ELSE
  3256. @@ -768,7 +768,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3257. *
  3258. CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  3259. $ 1 )
  3260. - TAULOC = TAU( JJV )
  3261. + TAULOC( 1 ) = TAU( JJV )
  3262. *
  3263. ELSE
  3264. *
  3265. @@ -777,7 +777,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3266. *
  3267. END IF
  3268. *
  3269. - IF( TAULOC.NE.ZERO ) THEN
  3270. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3271. *
  3272. * w := sub( C ) * v
  3273. *
  3274. @@ -795,8 +795,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3275. *
  3276. * sub( C ) := sub( C ) - w * v'
  3277. *
  3278. - CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
  3279. - $ C( IOFFC ), LDC )
  3280. + CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, WORK,
  3281. + $ 1, C( IOFFC ), LDC )
  3282. END IF
  3283. *
  3284. END IF
  3285. diff --git a/SRC/pslarz.f b/SRC/pslarz.f
  3286. index aa70db7..8901530 100644
  3287. --- a/SRC/pslarz.f
  3288. +++ b/SRC/pslarz.f
  3289. @@ -250,7 +250,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3290. $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
  3291. $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
  3292. $ NQC2, NQV, RDEST
  3293. - REAL TAULOC
  3294. + REAL TAULOC( 1 )
  3295. * ..
  3296. * .. External Subroutines ..
  3297. EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBSTRNV,
  3298. @@ -369,7 +369,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3299. *
  3300. CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  3301. $ TAU( IIV ), 1 )
  3302. - TAULOC = TAU( IIV )
  3303. + TAULOC( 1 ) = TAU( IIV )
  3304. *
  3305. ELSE
  3306. *
  3307. @@ -378,7 +378,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3308. *
  3309. END IF
  3310. *
  3311. - IF( TAULOC.NE.ZERO ) THEN
  3312. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3313. *
  3314. * w := sub( C )' * v
  3315. *
  3316. @@ -401,9 +401,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3317. * sub( C ) := sub( C ) - v * w'
  3318. *
  3319. IF( MYROW.EQ.ICROW1 )
  3320. - $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ),
  3321. + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  3322. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  3323. - CALL SGER( MPV, NQC2, -TAULOC, WORK, 1,
  3324. + CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  3325. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  3326. END IF
  3327. *
  3328. @@ -419,9 +419,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3329. *
  3330. IF( MYCOL.EQ.ICCOL2 ) THEN
  3331. *
  3332. - TAULOC = TAU( JJV )
  3333. + TAULOC( 1 ) = TAU( JJV )
  3334. *
  3335. - IF( TAULOC.NE.ZERO ) THEN
  3336. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3337. *
  3338. * w := sub( C )' * v
  3339. *
  3340. @@ -444,11 +444,11 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3341. * sub( C ) := sub( C ) - v * w'
  3342. *
  3343. IF( MYROW.EQ.ICROW1 )
  3344. - $ CALL SAXPY( NQC2, -TAULOC, WORK,
  3345. + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK,
  3346. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  3347. $ LDC )
  3348. - CALL SGER( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
  3349. - $ WORK, 1, C( IOFFC2 ), LDC )
  3350. + CALL SGER( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
  3351. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  3352. END IF
  3353. *
  3354. END IF
  3355. @@ -470,9 +470,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3356. IPW = MPV+1
  3357. CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  3358. $ IVCOL )
  3359. - TAULOC = WORK( IPW )
  3360. + TAULOC( 1 ) = WORK( IPW )
  3361. *
  3362. - IF( TAULOC.NE.ZERO ) THEN
  3363. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3364. *
  3365. * w := sub( C )' * v
  3366. *
  3367. @@ -495,10 +495,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3368. * sub( C ) := sub( C ) - v * w'
  3369. *
  3370. IF( MYROW.EQ.ICROW1 )
  3371. - $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ),
  3372. + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  3373. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  3374. $ LDC )
  3375. - CALL SGER( MPV, NQC2, -TAULOC, WORK, 1,
  3376. + CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  3377. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  3378. END IF
  3379. *
  3380. @@ -529,7 +529,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3381. *
  3382. CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  3383. $ TAU( IIV ), 1 )
  3384. - TAULOC = TAU( IIV )
  3385. + TAULOC( 1 ) = TAU( IIV )
  3386. *
  3387. ELSE
  3388. *
  3389. @@ -538,7 +538,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3390. *
  3391. END IF
  3392. *
  3393. - IF( TAULOC.NE.ZERO ) THEN
  3394. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3395. *
  3396. * w := sub( C )' * v
  3397. *
  3398. @@ -561,10 +561,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3399. * sub( C ) := sub( C ) - v * w'
  3400. *
  3401. IF( MYROW.EQ.ICROW1 )
  3402. - $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ),
  3403. + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  3404. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  3405. - CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  3406. - $ 1, C( IOFFC2 ), LDC )
  3407. + CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  3408. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  3409. END IF
  3410. *
  3411. ELSE
  3412. @@ -579,18 +579,18 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3413. WORK( IPW ) = TAU( JJV )
  3414. CALL SGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  3415. $ WORK, IPW )
  3416. - TAULOC = TAU( JJV )
  3417. + TAULOC( 1 ) = TAU( JJV )
  3418. *
  3419. ELSE
  3420. *
  3421. IPW = MPV+1
  3422. CALL SGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  3423. $ IPW, MYROW, IVCOL )
  3424. - TAULOC = WORK( IPW )
  3425. + TAULOC( 1 ) = WORK( IPW )
  3426. *
  3427. END IF
  3428. *
  3429. - IF( TAULOC.NE.ZERO ) THEN
  3430. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3431. *
  3432. * w := sub( C )' * v
  3433. *
  3434. @@ -613,10 +613,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3435. * sub( C ) := sub( C ) - v * w'
  3436. *
  3437. IF( MYROW.EQ.ICROW1 )
  3438. - $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ),
  3439. + $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  3440. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  3441. - CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  3442. - $ 1, C( IOFFC2 ), LDC )
  3443. + CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  3444. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  3445. END IF
  3446. *
  3447. END IF
  3448. @@ -645,9 +645,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3449. *
  3450. IF( MYROW.EQ.ICROW2 ) THEN
  3451. *
  3452. - TAULOC = TAU( IIV )
  3453. + TAULOC( 1 ) = TAU( IIV )
  3454. *
  3455. - IF( TAULOC.NE.ZERO ) THEN
  3456. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3457. *
  3458. * w := sub( C ) * v
  3459. *
  3460. @@ -668,13 +668,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3461. $ ICCOL2 )
  3462. *
  3463. IF( MYCOL.EQ.ICCOL1 )
  3464. - $ CALL SAXPY( MPC2, -TAULOC, WORK, 1,
  3465. + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
  3466. $ C( IOFFC1 ), 1 )
  3467. *
  3468. * sub( C ) := sub( C ) - w * v'
  3469. *
  3470. IF( MPC2.GT.0 .AND. NQV.GT.0 )
  3471. - $ CALL SGER( MPC2, NQV, -TAULOC, WORK, 1,
  3472. + $ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
  3473. $ V( IOFFV ), LDV, C( IOFFC2 ),
  3474. $ LDC )
  3475. END IF
  3476. @@ -698,9 +698,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3477. IPW = NQV+1
  3478. CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  3479. $ MYCOL )
  3480. - TAULOC = WORK( IPW )
  3481. + TAULOC( 1 ) = WORK( IPW )
  3482. *
  3483. - IF( TAULOC.NE.ZERO ) THEN
  3484. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3485. *
  3486. * w := sub( C ) * v
  3487. *
  3488. @@ -719,13 +719,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3489. $ WORK( IPW ), MAX( 1, MPC2 ),
  3490. $ RDEST, ICCOL2 )
  3491. IF( MYCOL.EQ.ICCOL1 )
  3492. - $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  3493. - $ C( IOFFC1 ), 1 )
  3494. + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
  3495. + $ 1, C( IOFFC1 ), 1 )
  3496. *
  3497. * sub( C ) := sub( C ) - w * v'
  3498. *
  3499. - CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  3500. - $ WORK, 1, C( IOFFC2 ), LDC )
  3501. + CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
  3502. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  3503. END IF
  3504. *
  3505. END IF
  3506. @@ -750,7 +750,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3507. *
  3508. CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  3509. $ TAU( JJV ), 1 )
  3510. - TAULOC = TAU( JJV )
  3511. + TAULOC( 1 ) = TAU( JJV )
  3512. *
  3513. ELSE
  3514. *
  3515. @@ -759,7 +759,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3516. *
  3517. END IF
  3518. *
  3519. - IF( TAULOC.NE.ZERO ) THEN
  3520. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3521. *
  3522. * w := sub( C ) * v
  3523. *
  3524. @@ -778,12 +778,12 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3525. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  3526. $ ICCOL2 )
  3527. IF( MYCOL.EQ.ICCOL1 )
  3528. - $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  3529. + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  3530. $ C( IOFFC1 ), 1 )
  3531. *
  3532. * sub( C ) := sub( C ) - w * v'
  3533. *
  3534. - CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  3535. + CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  3536. $ WORK, 1, C( IOFFC2 ), LDC )
  3537. END IF
  3538. *
  3539. @@ -808,18 +808,18 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3540. WORK( IPW ) = TAU( IIV )
  3541. CALL SGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  3542. $ WORK, IPW )
  3543. - TAULOC = TAU( IIV )
  3544. + TAULOC( 1 ) = TAU( IIV )
  3545. *
  3546. ELSE
  3547. *
  3548. IPW = NQV+1
  3549. CALL SGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  3550. $ WORK, IPW, IVROW, MYCOL )
  3551. - TAULOC = WORK( IPW )
  3552. + TAULOC( 1 ) = WORK( IPW )
  3553. *
  3554. END IF
  3555. *
  3556. - IF( TAULOC.NE.ZERO ) THEN
  3557. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3558. *
  3559. * w := sub( C ) * v
  3560. *
  3561. @@ -839,13 +839,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3562. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  3563. $ ICCOL2 )
  3564. IF( MYCOL.EQ.ICCOL1 )
  3565. - $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  3566. + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  3567. $ C( IOFFC1 ), 1 )
  3568. *
  3569. * sub( C ) := sub( C ) - w * v'
  3570. *
  3571. - CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  3572. - $ 1, C( IOFFC2 ), LDC )
  3573. + CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  3574. + $ WORK, 1, C( IOFFC2 ), LDC )
  3575. END IF
  3576. *
  3577. ELSE
  3578. @@ -864,7 +864,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3579. *
  3580. CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  3581. $ 1 )
  3582. - TAULOC = TAU( JJV )
  3583. + TAULOC( 1 ) = TAU( JJV )
  3584. *
  3585. ELSE
  3586. *
  3587. @@ -873,7 +873,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3588. *
  3589. END IF
  3590. *
  3591. - IF( TAULOC.NE.ZERO ) THEN
  3592. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3593. *
  3594. * w := sub( C ) * v
  3595. *
  3596. @@ -892,13 +892,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  3597. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  3598. $ ICCOL2 )
  3599. IF( MYCOL.EQ.ICCOL1 )
  3600. - $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  3601. + $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  3602. $ C( IOFFC1 ), 1 )
  3603. *
  3604. * sub( C ) := sub( C ) - w * v'
  3605. *
  3606. - CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  3607. - $ 1, C( IOFFC2 ), LDC )
  3608. + CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  3609. + $ WORK, 1, C( IOFFC2 ), LDC )
  3610. END IF
  3611. *
  3612. END IF
  3613. diff --git a/SRC/pslawil.f b/SRC/pslawil.f
  3614. index e04c16b..671e08e 100644
  3615. --- a/SRC/pslawil.f
  3616. +++ b/SRC/pslawil.f
  3617. @@ -120,10 +120,14 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  3618. INTEGER CONTXT, DOWN, HBL, ICOL, IROW, JSRC, LDA, LEFT,
  3619. $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT,
  3620. $ RSRC, UP
  3621. - REAL H11, H12, H21, H22, H33S, H44S, S, V1, V2, V3
  3622. + REAL H22, H33S, H44S, S, V1, V2
  3623. * ..
  3624. * .. Local Arrays ..
  3625. REAL BUF( 4 )
  3626. + REAL H11( 1 )
  3627. + REAL H12( 1 )
  3628. + REAL H21( 1 )
  3629. + REAL V3( 1 )
  3630. * ..
  3631. * .. External Subroutines ..
  3632. EXTERNAL BLACS_GRIDINFO, SGERV2D, SGESD2D, INFOG2L
  3633. @@ -170,18 +174,18 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  3634. IF( NPCOL.GT.1 ) THEN
  3635. CALL SGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT )
  3636. ELSE
  3637. - V3 = A( ( ICOL-2 )*LDA+IROW )
  3638. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  3639. END IF
  3640. IF( NUM.GT.1 ) THEN
  3641. CALL SGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT )
  3642. - H11 = BUF( 1 )
  3643. - H21 = BUF( 2 )
  3644. - H12 = BUF( 3 )
  3645. + H11( 1 ) = BUF( 1 )
  3646. + H21( 1 ) = BUF( 2 )
  3647. + H12( 1 ) = BUF( 3 )
  3648. H22 = BUF( 4 )
  3649. ELSE
  3650. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  3651. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  3652. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  3653. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  3654. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  3655. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  3656. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  3657. END IF
  3658. END IF
  3659. @@ -214,20 +218,20 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  3660. IF( NUM.GT.1 ) THEN
  3661. CALL SGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT )
  3662. ELSE
  3663. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  3664. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  3665. END IF
  3666. IF( NPROW.GT.1 ) THEN
  3667. CALL SGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL )
  3668. ELSE
  3669. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  3670. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  3671. END IF
  3672. IF( NPCOL.GT.1 ) THEN
  3673. CALL SGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT )
  3674. ELSE
  3675. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  3676. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  3677. END IF
  3678. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  3679. - V3 = A( ( ICOL-2 )*LDA+IROW )
  3680. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  3681. END IF
  3682. END IF
  3683. IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) )
  3684. @@ -236,24 +240,24 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  3685. IF( MODKM1.GT.1 ) THEN
  3686. CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
  3687. $ IROW, ICOL, RSRC, JSRC )
  3688. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  3689. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  3690. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  3691. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  3692. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  3693. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  3694. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  3695. - V3 = A( ( ICOL-2 )*LDA+IROW )
  3696. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  3697. END IF
  3698. *
  3699. - H44S = H44 - H11
  3700. - H33S = H33 - H11
  3701. - V1 = ( H33S*H44S-H43H34 ) / H21 + H12
  3702. - V2 = H22 - H11 - H33S - H44S
  3703. - S = ABS( V1 ) + ABS( V2 ) + ABS( V3 )
  3704. + H44S = H44 - H11( 1 )
  3705. + H33S = H33 - H11( 1 )
  3706. + V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 )
  3707. + V2 = H22 - H11( 1 ) - H33S - H44S
  3708. + S = ABS( V1 ) + ABS( V2 ) + ABS( V3( 1 ) )
  3709. V1 = V1 / S
  3710. V2 = V2 / S
  3711. - V3 = V3 / S
  3712. + V3( 1 ) = V3( 1 ) / S
  3713. V( 1 ) = V1
  3714. V( 2 ) = V2
  3715. - V( 3 ) = V3
  3716. + V( 3 ) = V3( 1 )
  3717. *
  3718. RETURN
  3719. *
  3720. diff --git a/SRC/psstebz.f b/SRC/psstebz.f
  3721. index a8a2496..7e588a9 100644
  3722. --- a/SRC/psstebz.f
  3723. +++ b/SRC/psstebz.f
  3724. @@ -244,14 +244,14 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU,
  3725. $ ITMP2, J, JB, K, LAST, LEXTRA, LREQ, MYCOL,
  3726. $ MYROW, NALPHA, NBETA, NCMP, NEIGINT, NEXT, NGL,
  3727. $ NGLOB, NGU, NINT, NPCOL, NPROW, OFFSET,
  3728. - $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF,
  3729. - $ TORECV
  3730. + $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF
  3731. REAL ALPHA, ATOLI, BETA, BNORM, DRECV, DSEND, GL,
  3732. $ GU, INITVL, INITVU, LSAVE, MID, PIVMIN, RELTOL,
  3733. $ SAFEMN, TMP1, TMP2, TNORM, ULP
  3734. * ..
  3735. * .. Local Arrays ..
  3736. INTEGER IDUM( 5, 2 )
  3737. + INTEGER TORECV( 1, 1 )
  3738. * ..
  3739. * .. Executable Statements ..
  3740. * This is just to keep ftnchek happy
  3741. @@ -774,14 +774,14 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU,
  3742. ELSE
  3743. CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', 1, 1, TORECV, 1, 0,
  3744. $ I-1 )
  3745. - IF( TORECV.NE.0 ) THEN
  3746. - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, IWORK,
  3747. - $ TORECV, 0, I-1 )
  3748. - CALL SGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, WORK,
  3749. - $ TORECV, 0, I-1 )
  3750. - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1,
  3751. - $ IWORK( N+1 ), TORECV, 0, I-1 )
  3752. - DO 120 J = 1, TORECV
  3753. + IF( TORECV( 1, 1 ).NE.0 ) THEN
  3754. + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
  3755. + $ IWORK, TORECV( 1, 1 ), 0, I-1 )
  3756. + CALL SGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
  3757. + $ WORK, TORECV( 1, 1 ), 0, I-1 )
  3758. + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1,
  3759. + $ IWORK( N+1 ), TORECV( 1, 1 ), 0, I-1 )
  3760. + DO 120 J = 1, TORECV( 1, 1 )
  3761. W( IWORK( J ) ) = WORK( J )
  3762. IBLOCK( IWORK( J ) ) = IWORK( N+J )
  3763. 120 CONTINUE
  3764. diff --git a/SRC/pstrord.f b/SRC/pstrord.f
  3765. index 3562242..5cdb549 100644
  3766. --- a/SRC/pstrord.f
  3767. +++ b/SRC/pstrord.f
  3768. @@ -328,12 +328,13 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  3769. $ EAST, WEST, ILOC4, SOUTH, NORTH, INDXS,
  3770. $ ITT, JTT, ILEN, DLEN, INDXE, TRSRC1, TCSRC1,
  3771. $ TRSRC2, TCSRC2, ILOS, DIR, TLIHI, TLILO, TLSEL,
  3772. - $ ROUND, LAST, WIN0S, WIN0E, WINE, MMAX, MMIN
  3773. + $ ROUND, LAST, WIN0S, WIN0E, WINE
  3774. REAL ELEM, ELEM1, ELEM2, ELEM3, ELEM4, SN, CS, TMP,
  3775. $ ELEM5
  3776. * ..
  3777. * .. Local Arrays ..
  3778. - INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 )
  3779. + INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ), MMAX( 1 ),
  3780. + $ MMIN( 1 ), INFODUM( 1 )
  3781. * ..
  3782. * .. External Functions ..
  3783. LOGICAL LSAME
  3784. @@ -483,16 +484,16 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  3785. END IF
  3786. IF( SELECT(K).NE.0 ) M = M + 1
  3787. 10 CONTINUE
  3788. - MMAX = M
  3789. - MMIN = M
  3790. + MMAX( 1 ) = M
  3791. + MMIN( 1 ) = M
  3792. IF( NPROCS.GT.1 )
  3793. $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1,
  3794. $ -1, -1, -1, -1 )
  3795. IF( NPROCS.GT.1 )
  3796. $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1,
  3797. $ -1, -1, -1, -1 )
  3798. - IF( MMAX.GT.MMIN ) THEN
  3799. - M = MMAX
  3800. + IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN
  3801. + M = MMAX( 1 )
  3802. IF( NPROCS.GT.1 )
  3803. $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, SELECT, N,
  3804. $ -1, -1, -1, -1, -1 )
  3805. @@ -520,9 +521,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  3806. *
  3807. * Global maximum on info.
  3808. *
  3809. - IF( NPROCS.GT.1 )
  3810. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1,
  3811. - $ -1, -1 )
  3812. + IF( NPROCS.GT.1 ) THEN
  3813. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1,
  3814. + $ -1, -1, -1 )
  3815. + INFO = INFODUM( 1 )
  3816. + END IF
  3817. *
  3818. * Return if some argument is incorrect.
  3819. *
  3820. @@ -1576,9 +1579,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  3821. * experienced a failure in the reordering.
  3822. *
  3823. MYIERR = IERR
  3824. - IF( NPROCS.GT.1 )
  3825. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1,
  3826. + IF( NPROCS.GT.1 ) THEN
  3827. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
  3828. $ -1, -1, -1, -1 )
  3829. + IERR = INFODUM( 1 )
  3830. + END IF
  3831. *
  3832. IF( IERR.NE.0 ) THEN
  3833. *
  3834. @@ -1586,9 +1591,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  3835. * to swap.
  3836. *
  3837. IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1)
  3838. - IF( NPROCS.GT.1 )
  3839. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1,
  3840. + IF( NPROCS.GT.1 ) THEN
  3841. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
  3842. $ -1, -1, -1, -1 )
  3843. + INFO = INFODUM( 1 )
  3844. + END IF
  3845. GO TO 300
  3846. END IF
  3847. *
  3848. @@ -3245,9 +3252,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  3849. * experienced a failure in the reordering.
  3850. *
  3851. MYIERR = IERR
  3852. - IF( NPROCS.GT.1 )
  3853. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1,
  3854. + IF( NPROCS.GT.1 ) THEN
  3855. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
  3856. $ -1, -1, -1, -1 )
  3857. + IERR = INFODUM( 1 )
  3858. + END IF
  3859. *
  3860. IF( IERR.NE.0 ) THEN
  3861. *
  3862. @@ -3255,9 +3264,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT,
  3863. * to swap.
  3864. *
  3865. IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1)
  3866. - IF( NPROCS.GT.1 )
  3867. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1,
  3868. + IF( NPROCS.GT.1 ) THEN
  3869. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1,
  3870. $ -1, -1, -1, -1 )
  3871. + INFO = INFODUM( 1 )
  3872. + END IF
  3873. GO TO 300
  3874. END IF
  3875. *
  3876. diff --git a/SRC/pstrsen.f b/SRC/pstrsen.f
  3877. index 6219bdb..1922e8f 100644
  3878. --- a/SRC/pstrsen.f
  3879. +++ b/SRC/pstrsen.f
  3880. @@ -354,13 +354,15 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
  3881. LOGICAL LQUERY, WANTBH, WANTQ, WANTS, WANTSP
  3882. INTEGER ICOFFT12, ICTXT, IDUM1, IDUM2, IERR, ILOC1,
  3883. $ IPW1, ITER, ITT, JLOC1, JTT, K, LIWMIN, LLDT,
  3884. - $ LLDQ, LWMIN, MMAX, MMIN, MYROW, MYCOL, N1, N2,
  3885. + $ LLDQ, LWMIN, MYROW, MYCOL, N1, N2,
  3886. $ NB, NOEXSY, NPCOL, NPROCS, NPROW, SPACE,
  3887. $ T12ROWS, T12COLS, TCOLS, TCSRC, TROWS, TRSRC,
  3888. $ WRK1, IWRK1, WRK2, IWRK2, WRK3, IWRK3
  3889. - REAL DPDUM1, ELEM, EST, SCALE, RNORM
  3890. + REAL ELEM, EST, SCALE, RNORM
  3891. * .. Local Arrays ..
  3892. - INTEGER DESCT12( DLEN_ ), MBNB2( 2 )
  3893. + INTEGER DESCT12( DLEN_ ), MBNB2( 2 ), MMAX( 1 ),
  3894. + $ MMIN( 1 ), INFODUM( 1 )
  3895. + REAL DPDUM1( 1 )
  3896. * ..
  3897. * .. External Functions ..
  3898. LOGICAL LSAME
  3899. @@ -521,16 +523,16 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
  3900. END IF
  3901. IF( SELECT(K) ) M = M + 1
  3902. 10 CONTINUE
  3903. - MMAX = M
  3904. - MMIN = M
  3905. + MMAX( 1 ) = M
  3906. + MMIN( 1 ) = M
  3907. IF( NPROCS.GT.1 )
  3908. $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1,
  3909. $ -1, -1, -1, -1 )
  3910. IF( NPROCS.GT.1 )
  3911. $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1,
  3912. $ -1, -1, -1, -1 )
  3913. - IF( MMAX.GT.MMIN ) THEN
  3914. - M = MMAX
  3915. + IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN
  3916. + M = MMAX( 1 )
  3917. IF( NPROCS.GT.1 )
  3918. $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, IWORK, N,
  3919. $ -1, -1, -1, -1, -1 )
  3920. @@ -602,9 +604,11 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT,
  3921. *
  3922. * Global maximum on info
  3923. *
  3924. - IF( NPROCS.GT.1 )
  3925. - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1,
  3926. + IF( NPROCS.GT.1 ) THEN
  3927. + CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, -1,
  3928. $ -1, -1 )
  3929. + INFO = INFODUM( 1 )
  3930. + END IF
  3931. *
  3932. * Return if some argument is incorrect
  3933. *
  3934. diff --git a/SRC/pzlarf.f b/SRC/pzlarf.f
  3935. index df65912..7bff287 100644
  3936. --- a/SRC/pzlarf.f
  3937. +++ b/SRC/pzlarf.f
  3938. @@ -242,7 +242,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3939. $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
  3940. $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
  3941. $ NQ, RDEST
  3942. - COMPLEX*16 TAULOC
  3943. + COMPLEX*16 TAULOC( 1 )
  3944. * ..
  3945. * .. External Subroutines ..
  3946. EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV,
  3947. @@ -336,7 +336,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3948. *
  3949. CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  3950. $ TAU( IIV ), 1 )
  3951. - TAULOC = TAU( IIV )
  3952. + TAULOC( 1 ) = TAU( IIV )
  3953. *
  3954. ELSE
  3955. *
  3956. @@ -345,7 +345,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3957. *
  3958. END IF
  3959. *
  3960. - IF( TAULOC.NE.ZERO ) THEN
  3961. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3962. *
  3963. * w := sub( C )' * v
  3964. *
  3965. @@ -363,8 +363,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3966. *
  3967. * sub( C ) := sub( C ) - v * w'
  3968. *
  3969. - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  3970. - $ 1, C( IOFFC ), LDC )
  3971. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  3972. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  3973. END IF
  3974. *
  3975. END IF
  3976. @@ -379,9 +379,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3977. *
  3978. IF( MYCOL.EQ.ICCOL ) THEN
  3979. *
  3980. - TAULOC = TAU( JJV )
  3981. + TAULOC( 1 ) = TAU( JJV )
  3982. *
  3983. - IF( TAULOC.NE.ZERO ) THEN
  3984. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  3985. *
  3986. * w := sub( C )' * v
  3987. *
  3988. @@ -398,7 +398,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3989. *
  3990. * sub( C ) := sub( C ) - v * w'
  3991. *
  3992. - CALL ZGERC( MP, NQ, -TAULOC, V( IOFFV ), 1,
  3993. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
  3994. $ WORK, 1, C( IOFFC ), LDC )
  3995. END IF
  3996. *
  3997. @@ -421,9 +421,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  3998. IPW = MP+1
  3999. CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  4000. $ IVCOL )
  4001. - TAULOC = WORK( IPW )
  4002. + TAULOC( 1 ) = WORK( IPW )
  4003. *
  4004. - IF( TAULOC.NE.ZERO ) THEN
  4005. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4006. *
  4007. * w := sub( C )' * v
  4008. *
  4009. @@ -441,7 +441,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4010. *
  4011. * sub( C ) := sub( C ) - v * w'
  4012. *
  4013. - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1,
  4014. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  4015. $ WORK( IPW ), 1, C( IOFFC ), LDC )
  4016. END IF
  4017. *
  4018. @@ -471,7 +471,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4019. *
  4020. CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  4021. $ TAU( IIV ), 1 )
  4022. - TAULOC = TAU( IIV )
  4023. + TAULOC( 1 ) = TAU( IIV )
  4024. *
  4025. ELSE
  4026. *
  4027. @@ -480,7 +480,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4028. *
  4029. END IF
  4030. *
  4031. - IF( TAULOC.NE.ZERO ) THEN
  4032. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4033. *
  4034. * w := sub( C )' * v
  4035. *
  4036. @@ -500,8 +500,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4037. * sub( C ) := sub( C ) - v * w'
  4038. *
  4039. IF( IOFFC.GT.0 )
  4040. - $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  4041. - $ 1, C( IOFFC ), LDC )
  4042. + $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  4043. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  4044. END IF
  4045. *
  4046. ELSE
  4047. @@ -516,18 +516,18 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4048. WORK(IPW) = TAU( JJV )
  4049. CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  4050. $ WORK, IPW )
  4051. - TAULOC = TAU( JJV )
  4052. + TAULOC( 1 ) = TAU( JJV )
  4053. *
  4054. ELSE
  4055. *
  4056. IPW = MP+1
  4057. CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  4058. $ IPW, MYROW, IVCOL )
  4059. - TAULOC = WORK( IPW )
  4060. + TAULOC( 1 ) = WORK( IPW )
  4061. *
  4062. END IF
  4063. *
  4064. - IF( TAULOC.NE.ZERO ) THEN
  4065. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4066. *
  4067. * w := sub( C )' * v
  4068. *
  4069. @@ -547,8 +547,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4070. * sub( C ) := sub( C ) - v * w'
  4071. *
  4072. IF( IOFFC.GT.0 )
  4073. - $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  4074. - $ 1, C( IOFFC ), LDC )
  4075. + $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  4076. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  4077. END IF
  4078. *
  4079. END IF
  4080. @@ -577,9 +577,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4081. *
  4082. IF( MYROW.EQ.ICROW ) THEN
  4083. *
  4084. - TAULOC = TAU( IIV )
  4085. + TAULOC( 1 ) = TAU( IIV )
  4086. *
  4087. - IF( TAULOC.NE.ZERO ) THEN
  4088. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4089. *
  4090. * w := sub( C ) * v
  4091. *
  4092. @@ -597,7 +597,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4093. * sub( C ) := sub( C ) - w * v'
  4094. *
  4095. IF( IOFFV.GT.0 .AND. IOFFC.GT.0 )
  4096. - $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1,
  4097. + $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  4098. $ V( IOFFV ), LDV, C( IOFFC ),
  4099. $ LDC )
  4100. END IF
  4101. @@ -621,9 +621,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4102. IPW = NQ+1
  4103. CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  4104. $ MYCOL )
  4105. - TAULOC = WORK( IPW )
  4106. + TAULOC( 1 ) = WORK( IPW )
  4107. *
  4108. - IF( TAULOC.NE.ZERO ) THEN
  4109. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4110. *
  4111. * w := sub( C ) * v
  4112. *
  4113. @@ -641,8 +641,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4114. *
  4115. * sub( C ) := sub( C ) - w * v'
  4116. *
  4117. - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1,
  4118. - $ WORK, 1, C( IOFFC ), LDC )
  4119. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ),
  4120. + $ 1, WORK, 1, C( IOFFC ), LDC )
  4121. END IF
  4122. *
  4123. END IF
  4124. @@ -667,7 +667,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4125. *
  4126. CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  4127. $ TAU( JJV ), 1 )
  4128. - TAULOC = TAU( JJV )
  4129. + TAULOC( 1 ) = TAU( JJV )
  4130. *
  4131. ELSE
  4132. *
  4133. @@ -676,7 +676,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4134. *
  4135. END IF
  4136. *
  4137. - IF( TAULOC.NE.ZERO ) THEN
  4138. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4139. *
  4140. * w := sub( C ) * v
  4141. *
  4142. @@ -694,8 +694,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4143. *
  4144. * sub( C ) := sub( C ) - w * v'
  4145. *
  4146. - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  4147. - $ 1, C( IOFFC ), LDC )
  4148. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  4149. + $ WORK, 1, C( IOFFC ), LDC )
  4150. END IF
  4151. *
  4152. END IF
  4153. @@ -720,18 +720,18 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4154. WORK(IPW) = TAU( IIV )
  4155. CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  4156. $ WORK, IPW )
  4157. - TAULOC = TAU( IIV )
  4158. + TAULOC( 1 ) = TAU( IIV )
  4159. *
  4160. ELSE
  4161. *
  4162. IPW = NQ+1
  4163. CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  4164. $ WORK, IPW, IVROW, MYCOL )
  4165. - TAULOC = WORK( IPW )
  4166. + TAULOC( 1 ) = WORK( IPW )
  4167. *
  4168. END IF
  4169. *
  4170. - IF( TAULOC.NE.ZERO ) THEN
  4171. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4172. *
  4173. * w := sub( C ) * v
  4174. *
  4175. @@ -750,8 +750,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4176. * sub( C ) := sub( C ) - w * v'
  4177. *
  4178. IF( IOFFC.GT.0 )
  4179. - $ CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  4180. - $ 1, C( IOFFC ), LDC )
  4181. + $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  4182. + $ WORK, 1, C( IOFFC ), LDC )
  4183. END IF
  4184. *
  4185. ELSE
  4186. @@ -770,7 +770,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4187. *
  4188. CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  4189. $ 1 )
  4190. - TAULOC = TAU( JJV )
  4191. + TAULOC( 1 ) = TAU( JJV )
  4192. *
  4193. ELSE
  4194. *
  4195. @@ -779,7 +779,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4196. *
  4197. END IF
  4198. *
  4199. - IF( TAULOC.NE.ZERO ) THEN
  4200. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4201. *
  4202. * w := sub( C ) * v
  4203. *
  4204. @@ -797,8 +797,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4205. *
  4206. * sub( C ) := sub( C ) - w * v'
  4207. *
  4208. - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
  4209. - $ C( IOFFC ), LDC )
  4210. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  4211. + $ WORK, 1, C( IOFFC ), LDC )
  4212. END IF
  4213. *
  4214. END IF
  4215. diff --git a/SRC/pzlarfc.f b/SRC/pzlarfc.f
  4216. index eb469fc..ddd7ec6 100644
  4217. --- a/SRC/pzlarfc.f
  4218. +++ b/SRC/pzlarfc.f
  4219. @@ -242,7 +242,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4220. $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC,
  4221. $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW,
  4222. $ NQ, RDEST
  4223. - COMPLEX*16 TAULOC
  4224. + COMPLEX*16 TAULOC( 1 )
  4225. * ..
  4226. * .. External Subroutines ..
  4227. EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV,
  4228. @@ -336,17 +336,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4229. *
  4230. CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  4231. $ TAU( IIV ), 1 )
  4232. - TAULOC = DCONJG( TAU( IIV ) )
  4233. + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
  4234. *
  4235. ELSE
  4236. *
  4237. CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
  4238. $ TAULOC, 1, IVROW, MYCOL )
  4239. - TAULOC = DCONJG( TAULOC )
  4240. + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
  4241. *
  4242. END IF
  4243. *
  4244. - IF( TAULOC.NE.ZERO ) THEN
  4245. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4246. *
  4247. * w := sub( C )' * v
  4248. *
  4249. @@ -364,8 +364,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4250. *
  4251. * sub( C ) := sub( C ) - v * w'
  4252. *
  4253. - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ),
  4254. - $ 1, C( IOFFC ), LDC )
  4255. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  4256. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  4257. END IF
  4258. *
  4259. END IF
  4260. @@ -380,9 +380,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4261. *
  4262. IF( MYCOL.EQ.ICCOL ) THEN
  4263. *
  4264. - TAULOC = DCONJG( TAU( JJV ) )
  4265. + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
  4266. *
  4267. - IF( TAULOC.NE.ZERO ) THEN
  4268. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4269. *
  4270. * w := sub( C )' * v
  4271. *
  4272. @@ -399,7 +399,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4273. *
  4274. * sub( C ) := sub( C ) - v * w'
  4275. *
  4276. - CALL ZGERC( MP, NQ, -TAULOC, V( IOFFV ), 1,
  4277. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1,
  4278. $ WORK, 1, C( IOFFC ), LDC )
  4279. END IF
  4280. *
  4281. @@ -422,9 +422,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4282. IPW = MP+1
  4283. CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  4284. $ IVCOL )
  4285. - TAULOC = DCONJG( WORK( IPW ) )
  4286. + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
  4287. *
  4288. - IF( TAULOC.NE.ZERO ) THEN
  4289. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4290. *
  4291. * w := sub( C )' * v
  4292. *
  4293. @@ -442,7 +442,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4294. *
  4295. * sub( C ) := sub( C ) - v * w'
  4296. *
  4297. - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1,
  4298. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  4299. $ WORK( IPW ), 1, C( IOFFC ), LDC )
  4300. END IF
  4301. *
  4302. @@ -472,17 +472,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4303. *
  4304. CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  4305. $ TAU( IIV ), 1 )
  4306. - TAULOC = DCONJG( TAU( IIV ) )
  4307. + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
  4308. *
  4309. ELSE
  4310. *
  4311. CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
  4312. $ 1, IVROW, MYCOL )
  4313. - TAULOC = DCONJG( TAULOC )
  4314. + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
  4315. *
  4316. END IF
  4317. *
  4318. - IF( TAULOC.NE.ZERO ) THEN
  4319. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4320. *
  4321. * w := sub( C )' * v
  4322. *
  4323. @@ -500,8 +500,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4324. *
  4325. * sub( C ) := sub( C ) - v * w'
  4326. *
  4327. - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1,
  4328. - $ C( IOFFC ), LDC )
  4329. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  4330. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  4331. END IF
  4332. *
  4333. ELSE
  4334. @@ -516,18 +516,18 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4335. WORK(IPW) = TAU( JJV )
  4336. CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  4337. $ WORK, IPW )
  4338. - TAULOC = DCONJG( TAU( JJV ) )
  4339. + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
  4340. *
  4341. ELSE
  4342. *
  4343. IPW = MP+1
  4344. CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  4345. $ IPW, MYROW, IVCOL )
  4346. - TAULOC = DCONJG( WORK( IPW ) )
  4347. + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
  4348. *
  4349. END IF
  4350. *
  4351. - IF( TAULOC.NE.ZERO ) THEN
  4352. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4353. *
  4354. * w := sub( C )' * v
  4355. *
  4356. @@ -545,8 +545,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4357. *
  4358. * sub( C ) := sub( C ) - v * w'
  4359. *
  4360. - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1,
  4361. - $ C( IOFFC ), LDC )
  4362. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  4363. + $ WORK( IPW ), 1, C( IOFFC ), LDC )
  4364. END IF
  4365. *
  4366. END IF
  4367. @@ -575,9 +575,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4368. *
  4369. IF( MYROW.EQ.ICROW ) THEN
  4370. *
  4371. - TAULOC = DCONJG( TAU( IIV ) )
  4372. + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
  4373. *
  4374. - IF( TAULOC.NE.ZERO ) THEN
  4375. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4376. *
  4377. * w := sub( C ) * v
  4378. *
  4379. @@ -594,7 +594,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4380. *
  4381. * sub( C ) := sub( C ) - w * v'
  4382. *
  4383. - CALL ZGERC( MP, NQ, -TAULOC, WORK, 1,
  4384. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1,
  4385. $ V( IOFFV ), LDV, C( IOFFC ), LDC )
  4386. END IF
  4387. *
  4388. @@ -617,9 +617,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4389. IPW = NQ+1
  4390. CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  4391. $ MYCOL )
  4392. - TAULOC = DCONJG( WORK( IPW ) )
  4393. + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
  4394. *
  4395. - IF( TAULOC.NE.ZERO ) THEN
  4396. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4397. *
  4398. * w := sub( C ) * v
  4399. *
  4400. @@ -637,8 +637,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4401. *
  4402. * sub( C ) := sub( C ) - w * v'
  4403. *
  4404. - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1,
  4405. - $ WORK, 1, C( IOFFC ), LDC )
  4406. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ),
  4407. + $ 1, WORK, 1, C( IOFFC ), LDC )
  4408. END IF
  4409. *
  4410. END IF
  4411. @@ -663,17 +663,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4412. *
  4413. CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  4414. $ TAU( JJV ), 1 )
  4415. - TAULOC = DCONJG( TAU( JJV ) )
  4416. + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
  4417. *
  4418. ELSE
  4419. *
  4420. CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
  4421. $ 1, MYROW, IVCOL )
  4422. - TAULOC = DCONJG( TAULOC )
  4423. + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
  4424. *
  4425. END IF
  4426. *
  4427. - IF( TAULOC.NE.ZERO ) THEN
  4428. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4429. *
  4430. * w := sub( C ) * v
  4431. *
  4432. @@ -691,8 +691,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4433. *
  4434. * sub( C ) := sub( C ) - w * v'
  4435. *
  4436. - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK,
  4437. - $ 1, C( IOFFC ), LDC )
  4438. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  4439. + $ WORK, 1, C( IOFFC ), LDC )
  4440. END IF
  4441. *
  4442. END IF
  4443. @@ -716,18 +716,18 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4444. WORK(IPW) = TAU( IIV )
  4445. CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  4446. $ WORK, IPW )
  4447. - TAULOC = DCONJG( TAU( IIV ) )
  4448. + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
  4449. *
  4450. ELSE
  4451. *
  4452. IPW = NQ+1
  4453. CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  4454. $ WORK, IPW, IVROW, MYCOL )
  4455. - TAULOC = DCONJG( WORK( IPW ) )
  4456. + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
  4457. *
  4458. END IF
  4459. *
  4460. - IF( TAULOC.NE.ZERO ) THEN
  4461. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4462. *
  4463. * w := sub( C ) * v
  4464. *
  4465. @@ -745,8 +745,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4466. *
  4467. * sub( C ) := sub( C ) - w * v'
  4468. *
  4469. - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
  4470. - $ C( IOFFC ), LDC )
  4471. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  4472. + $ WORK, 1, C( IOFFC ), LDC )
  4473. END IF
  4474. *
  4475. ELSE
  4476. @@ -765,17 +765,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4477. *
  4478. CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  4479. $ 1 )
  4480. - TAULOC = DCONJG( TAU( JJV ) )
  4481. + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
  4482. *
  4483. ELSE
  4484. *
  4485. CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1,
  4486. $ MYROW, IVCOL )
  4487. - TAULOC = DCONJG( TAULOC )
  4488. + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
  4489. *
  4490. END IF
  4491. *
  4492. - IF( TAULOC.NE.ZERO ) THEN
  4493. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4494. *
  4495. * w := sub( C ) * v
  4496. *
  4497. @@ -793,8 +793,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU,
  4498. *
  4499. * sub( C ) := sub( C ) - w * v'
  4500. *
  4501. - CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1,
  4502. - $ C( IOFFC ), LDC )
  4503. + CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1,
  4504. + $ WORK, 1, C( IOFFC ), LDC )
  4505. END IF
  4506. *
  4507. END IF
  4508. diff --git a/SRC/pzlarz.f b/SRC/pzlarz.f
  4509. index fefc133..abf6288 100644
  4510. --- a/SRC/pzlarz.f
  4511. +++ b/SRC/pzlarz.f
  4512. @@ -251,7 +251,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4513. $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
  4514. $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
  4515. $ NQC2, NQV, RDEST
  4516. - COMPLEX*16 TAULOC
  4517. + COMPLEX*16 TAULOC( 1 )
  4518. * ..
  4519. * .. External Subroutines ..
  4520. EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV,
  4521. @@ -370,7 +370,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4522. *
  4523. CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  4524. $ TAU( IIV ), 1 )
  4525. - TAULOC = TAU( IIV )
  4526. + TAULOC( 1 ) = TAU( IIV )
  4527. *
  4528. ELSE
  4529. *
  4530. @@ -379,7 +379,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4531. *
  4532. END IF
  4533. *
  4534. - IF( TAULOC.NE.ZERO ) THEN
  4535. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4536. *
  4537. * w := sub( C )' * v
  4538. *
  4539. @@ -402,9 +402,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4540. * sub( C ) := sub( C ) - v * w'
  4541. *
  4542. IF( MYROW.EQ.ICROW1 )
  4543. - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
  4544. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  4545. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  4546. - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1,
  4547. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  4548. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  4549. END IF
  4550. *
  4551. @@ -420,9 +420,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4552. *
  4553. IF( MYCOL.EQ.ICCOL2 ) THEN
  4554. *
  4555. - TAULOC = TAU( JJV )
  4556. + TAULOC( 1 ) = TAU( JJV )
  4557. *
  4558. - IF( TAULOC.NE.ZERO ) THEN
  4559. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4560. *
  4561. * w := sub( C )' * v
  4562. *
  4563. @@ -445,11 +445,11 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4564. * sub( C ) := sub( C ) - v * w'
  4565. *
  4566. IF( MYROW.EQ.ICROW1 )
  4567. - $ CALL ZAXPY( NQC2, -TAULOC, WORK,
  4568. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK,
  4569. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  4570. $ LDC )
  4571. - CALL ZGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
  4572. - $ WORK, 1, C( IOFFC2 ), LDC )
  4573. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
  4574. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  4575. END IF
  4576. *
  4577. END IF
  4578. @@ -471,9 +471,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4579. IPW = MPV+1
  4580. CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  4581. $ IVCOL )
  4582. - TAULOC = WORK( IPW )
  4583. + TAULOC( 1 ) = WORK( IPW )
  4584. *
  4585. - IF( TAULOC.NE.ZERO ) THEN
  4586. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4587. *
  4588. * w := sub( C )' * v
  4589. *
  4590. @@ -496,10 +496,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4591. * sub( C ) := sub( C ) - v * w'
  4592. *
  4593. IF( MYROW.EQ.ICROW1 )
  4594. - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
  4595. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  4596. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  4597. $ LDC )
  4598. - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1,
  4599. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  4600. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  4601. END IF
  4602. *
  4603. @@ -530,7 +530,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4604. *
  4605. CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  4606. $ TAU( IIV ), 1 )
  4607. - TAULOC = TAU( IIV )
  4608. + TAULOC( 1 ) = TAU( IIV )
  4609. *
  4610. ELSE
  4611. *
  4612. @@ -539,7 +539,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4613. *
  4614. END IF
  4615. *
  4616. - IF( TAULOC.NE.ZERO ) THEN
  4617. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4618. *
  4619. * w := sub( C )' * v
  4620. *
  4621. @@ -562,10 +562,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4622. * sub( C ) := sub( C ) - v * w'
  4623. *
  4624. IF( MYROW.EQ.ICROW1 )
  4625. - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
  4626. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  4627. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  4628. - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  4629. - $ 1, C( IOFFC2 ), LDC )
  4630. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  4631. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  4632. END IF
  4633. *
  4634. ELSE
  4635. @@ -580,18 +580,18 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4636. WORK( IPW ) = TAU( JJV )
  4637. CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  4638. $ WORK, IPW )
  4639. - TAULOC = TAU( JJV )
  4640. + TAULOC( 1 ) = TAU( JJV )
  4641. *
  4642. ELSE
  4643. *
  4644. IPW = MPV+1
  4645. CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  4646. $ IPW, MYROW, IVCOL )
  4647. - TAULOC = WORK( IPW )
  4648. + TAULOC( 1 ) = WORK( IPW )
  4649. *
  4650. END IF
  4651. *
  4652. - IF( TAULOC.NE.ZERO ) THEN
  4653. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4654. *
  4655. * w := sub( C )' * v
  4656. *
  4657. @@ -614,10 +614,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4658. * sub( C ) := sub( C ) - v * w'
  4659. *
  4660. IF( MYROW.EQ.ICROW1 )
  4661. - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
  4662. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  4663. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  4664. - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  4665. - $ 1, C( IOFFC2 ), LDC )
  4666. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  4667. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  4668. END IF
  4669. *
  4670. END IF
  4671. @@ -646,9 +646,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4672. *
  4673. IF( MYROW.EQ.ICROW2 ) THEN
  4674. *
  4675. - TAULOC = TAU( IIV )
  4676. + TAULOC( 1 ) = TAU( IIV )
  4677. *
  4678. - IF( TAULOC.NE.ZERO ) THEN
  4679. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4680. *
  4681. * w := sub( C ) * v
  4682. *
  4683. @@ -669,13 +669,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4684. $ ICCOL2 )
  4685. *
  4686. IF( MYCOL.EQ.ICCOL1 )
  4687. - $ CALL ZAXPY( MPC2, -TAULOC, WORK, 1,
  4688. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
  4689. $ C( IOFFC1 ), 1 )
  4690. *
  4691. * sub( C ) := sub( C ) - w * v'
  4692. *
  4693. IF( MPC2.GT.0 .AND. NQV.GT.0 )
  4694. - $ CALL ZGERC( MPC2, NQV, -TAULOC, WORK, 1,
  4695. + $ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
  4696. $ V( IOFFV ), LDV, C( IOFFC2 ),
  4697. $ LDC )
  4698. END IF
  4699. @@ -699,9 +699,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4700. IPW = NQV+1
  4701. CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  4702. $ MYCOL )
  4703. - TAULOC = WORK( IPW )
  4704. + TAULOC( 1 ) = WORK( IPW )
  4705. *
  4706. - IF( TAULOC.NE.ZERO ) THEN
  4707. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4708. *
  4709. * w := sub( C ) * v
  4710. *
  4711. @@ -720,13 +720,14 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4712. $ WORK( IPW ), MAX( 1, MPC2 ),
  4713. $ RDEST, ICCOL2 )
  4714. IF( MYCOL.EQ.ICCOL1 )
  4715. - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  4716. - $ C( IOFFC1 ), 1 )
  4717. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
  4718. + $ 1, C( IOFFC1 ), 1 )
  4719. *
  4720. * sub( C ) := sub( C ) - w * v'
  4721. *
  4722. - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  4723. - $ WORK, 1, C( IOFFC2 ), LDC )
  4724. + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ),
  4725. + $ WORK( IPW ), 1, WORK, 1,
  4726. + $ C( IOFFC2 ), LDC )
  4727. END IF
  4728. *
  4729. END IF
  4730. @@ -751,7 +752,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4731. *
  4732. CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  4733. $ TAU( JJV ), 1 )
  4734. - TAULOC = TAU( JJV )
  4735. + TAULOC( 1 ) = TAU( JJV )
  4736. *
  4737. ELSE
  4738. *
  4739. @@ -760,7 +761,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4740. *
  4741. END IF
  4742. *
  4743. - IF( TAULOC.NE.ZERO ) THEN
  4744. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4745. *
  4746. * w := sub( C ) * v
  4747. *
  4748. @@ -779,13 +780,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4749. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  4750. $ ICCOL2 )
  4751. IF( MYCOL.EQ.ICCOL1 )
  4752. - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  4753. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  4754. $ C( IOFFC1 ), 1 )
  4755. *
  4756. * sub( C ) := sub( C ) - w * v'
  4757. *
  4758. - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  4759. - $ WORK, 1, C( IOFFC2 ), LDC )
  4760. + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
  4761. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  4762. END IF
  4763. *
  4764. END IF
  4765. @@ -809,18 +810,18 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4766. WORK( IPW ) = TAU( IIV )
  4767. CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  4768. $ WORK, IPW )
  4769. - TAULOC = TAU( IIV )
  4770. + TAULOC( 1 ) = TAU( IIV )
  4771. *
  4772. ELSE
  4773. *
  4774. IPW = NQV+1
  4775. CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  4776. $ WORK, IPW, IVROW, MYCOL )
  4777. - TAULOC = WORK( IPW )
  4778. + TAULOC( 1 ) = WORK( IPW )
  4779. *
  4780. END IF
  4781. *
  4782. - IF( TAULOC.NE.ZERO ) THEN
  4783. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4784. *
  4785. * w := sub( C ) * v
  4786. *
  4787. @@ -840,13 +841,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4788. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  4789. $ ICCOL2 )
  4790. IF( MYCOL.EQ.ICCOL1 )
  4791. - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  4792. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  4793. $ C( IOFFC1 ), 1 )
  4794. *
  4795. * sub( C ) := sub( C ) - w * v'
  4796. *
  4797. - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  4798. - $ 1, C( IOFFC2 ), LDC )
  4799. + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  4800. + $ WORK, 1, C( IOFFC2 ), LDC )
  4801. END IF
  4802. *
  4803. ELSE
  4804. @@ -865,7 +866,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4805. *
  4806. CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  4807. $ 1 )
  4808. - TAULOC = TAU( JJV )
  4809. + TAULOC( 1 ) = TAU( JJV )
  4810. *
  4811. ELSE
  4812. *
  4813. @@ -874,7 +875,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4814. *
  4815. END IF
  4816. *
  4817. - IF( TAULOC.NE.ZERO ) THEN
  4818. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4819. *
  4820. * w := sub( C ) * v
  4821. *
  4822. @@ -893,13 +894,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4823. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  4824. $ ICCOL2 )
  4825. IF( MYCOL.EQ.ICCOL1 )
  4826. - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  4827. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  4828. $ C( IOFFC1 ), 1 )
  4829. *
  4830. * sub( C ) := sub( C ) - w * v'
  4831. *
  4832. - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  4833. - $ 1, C( IOFFC2 ), LDC )
  4834. + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  4835. + $ WORK, 1, C( IOFFC2 ), LDC )
  4836. END IF
  4837. *
  4838. END IF
  4839. diff --git a/SRC/pzlarzc.f b/SRC/pzlarzc.f
  4840. index 936caec..2c574ff 100644
  4841. --- a/SRC/pzlarzc.f
  4842. +++ b/SRC/pzlarzc.f
  4843. @@ -251,7 +251,7 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4844. $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2,
  4845. $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW,
  4846. $ NQC2, NQV, RDEST
  4847. - COMPLEX*16 TAULOC
  4848. + COMPLEX*16 TAULOC( 1 )
  4849. * ..
  4850. * .. External Subroutines ..
  4851. EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV,
  4852. @@ -370,17 +370,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4853. *
  4854. CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  4855. $ TAU( IIV ), 1 )
  4856. - TAULOC = DCONJG( TAU( IIV ) )
  4857. + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
  4858. *
  4859. ELSE
  4860. *
  4861. CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1,
  4862. $ TAULOC, 1, IVROW, MYCOL )
  4863. - TAULOC = DCONJG( TAULOC )
  4864. + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
  4865. *
  4866. END IF
  4867. *
  4868. - IF( TAULOC.NE.ZERO ) THEN
  4869. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4870. *
  4871. * w := sub( C )' * v
  4872. *
  4873. @@ -403,9 +403,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4874. * sub( C ) := sub( C ) - v * w'
  4875. *
  4876. IF( MYROW.EQ.ICROW1 )
  4877. - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
  4878. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  4879. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  4880. - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1,
  4881. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  4882. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  4883. END IF
  4884. *
  4885. @@ -421,9 +421,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4886. *
  4887. IF( MYCOL.EQ.ICCOL2 ) THEN
  4888. *
  4889. - TAULOC = DCONJG( TAU( JJV ) )
  4890. + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
  4891. *
  4892. - IF( TAULOC.NE.ZERO ) THEN
  4893. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4894. *
  4895. * w := sub( C )' * v
  4896. *
  4897. @@ -446,11 +446,11 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4898. * sub( C ) := sub( C ) - v * w'
  4899. *
  4900. IF( MYROW.EQ.ICROW1 )
  4901. - $ CALL ZAXPY( NQC2, -TAULOC, WORK,
  4902. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK,
  4903. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  4904. $ LDC )
  4905. - CALL ZGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1,
  4906. - $ WORK, 1, C( IOFFC2 ), LDC )
  4907. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ),
  4908. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  4909. END IF
  4910. *
  4911. END IF
  4912. @@ -472,9 +472,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4913. IPW = MPV+1
  4914. CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW,
  4915. $ IVCOL )
  4916. - TAULOC = DCONJG( WORK( IPW ) )
  4917. + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
  4918. *
  4919. - IF( TAULOC.NE.ZERO ) THEN
  4920. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4921. *
  4922. * w := sub( C )' * v
  4923. *
  4924. @@ -497,10 +497,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4925. * sub( C ) := sub( C ) - v * w'
  4926. *
  4927. IF( MYROW.EQ.ICROW1 )
  4928. - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
  4929. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  4930. $ MAX( 1, NQC2 ), C( IOFFC1 ),
  4931. $ LDC )
  4932. - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1,
  4933. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  4934. $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  4935. END IF
  4936. *
  4937. @@ -531,17 +531,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4938. *
  4939. CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1,
  4940. $ TAU( IIV ), 1 )
  4941. - TAULOC = DCONJG( TAU( IIV ) )
  4942. + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
  4943. *
  4944. ELSE
  4945. *
  4946. CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC,
  4947. $ 1, IVROW, MYCOL )
  4948. - TAULOC = DCONJG( TAULOC )
  4949. + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
  4950. *
  4951. END IF
  4952. *
  4953. - IF( TAULOC.NE.ZERO ) THEN
  4954. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4955. *
  4956. * w := sub( C )' * v
  4957. *
  4958. @@ -564,10 +564,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4959. * sub( C ) := sub( C ) - v * w'
  4960. *
  4961. IF( MYROW.EQ.ICROW1 )
  4962. - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
  4963. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  4964. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  4965. - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  4966. - $ 1, C( IOFFC2 ), LDC )
  4967. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  4968. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  4969. END IF
  4970. *
  4971. ELSE
  4972. @@ -582,18 +582,18 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4973. WORK( IPW ) = TAU( JJV )
  4974. CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1,
  4975. $ WORK, IPW )
  4976. - TAULOC = DCONJG( TAU( JJV ) )
  4977. + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
  4978. *
  4979. ELSE
  4980. *
  4981. IPW = MPV+1
  4982. CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK,
  4983. $ IPW, MYROW, IVCOL )
  4984. - TAULOC = DCONJG( WORK( IPW ) )
  4985. + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
  4986. *
  4987. END IF
  4988. *
  4989. - IF( TAULOC.NE.ZERO ) THEN
  4990. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  4991. *
  4992. * w := sub( C )' * v
  4993. *
  4994. @@ -616,10 +616,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  4995. * sub( C ) := sub( C ) - v * w'
  4996. *
  4997. IF( MYROW.EQ.ICROW1 )
  4998. - $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ),
  4999. + $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ),
  5000. $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC )
  5001. - CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ),
  5002. - $ 1, C( IOFFC2 ), LDC )
  5003. + CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1,
  5004. + $ WORK( IPW ), 1, C( IOFFC2 ), LDC )
  5005. END IF
  5006. *
  5007. END IF
  5008. @@ -648,9 +648,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5009. *
  5010. IF( MYROW.EQ.ICROW2 ) THEN
  5011. *
  5012. - TAULOC = DCONJG( TAU( IIV ) )
  5013. + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
  5014. *
  5015. - IF( TAULOC.NE.ZERO ) THEN
  5016. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  5017. *
  5018. * w := sub( C ) * v
  5019. *
  5020. @@ -671,12 +671,12 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5021. $ ICCOL2 )
  5022. *
  5023. IF( MYCOL.EQ.ICCOL1 )
  5024. - $ CALL ZAXPY( MPC2, -TAULOC, WORK, 1,
  5025. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK, 1,
  5026. $ C( IOFFC1 ), 1 )
  5027. *
  5028. * sub( C ) := sub( C ) - w * v'
  5029. *
  5030. - CALL ZGERC( MPC2, NQV, -TAULOC, WORK, 1,
  5031. + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1,
  5032. $ V( IOFFV ), LDV, C( IOFFC2 ), LDC )
  5033. END IF
  5034. *
  5035. @@ -699,9 +699,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5036. IPW = NQV+1
  5037. CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW,
  5038. $ MYCOL )
  5039. - TAULOC = DCONJG( WORK( IPW ) )
  5040. + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
  5041. *
  5042. - IF( TAULOC.NE.ZERO ) THEN
  5043. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  5044. *
  5045. * w := sub( C ) * v
  5046. *
  5047. @@ -720,13 +720,14 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5048. $ WORK( IPW ), MAX( 1, MPC2 ),
  5049. $ RDEST, ICCOL2 )
  5050. IF( MYCOL.EQ.ICCOL1 )
  5051. - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  5052. - $ C( IOFFC1 ), 1 )
  5053. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ),
  5054. + $ 1, C( IOFFC1 ), 1 )
  5055. *
  5056. * sub( C ) := sub( C ) - w * v'
  5057. *
  5058. - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  5059. - $ WORK, 1, C( IOFFC2 ), LDC )
  5060. + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ),
  5061. + $ WORK( IPW ), 1, WORK, 1,
  5062. + $ C( IOFFC2 ), LDC )
  5063. END IF
  5064. *
  5065. END IF
  5066. @@ -751,17 +752,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5067. *
  5068. CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1,
  5069. $ TAU( JJV ), 1 )
  5070. - TAULOC = DCONJG( TAU( JJV ) )
  5071. + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
  5072. *
  5073. ELSE
  5074. *
  5075. CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC,
  5076. $ 1, MYROW, IVCOL )
  5077. - TAULOC = DCONJG( TAULOC )
  5078. + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
  5079. *
  5080. END IF
  5081. *
  5082. - IF( TAULOC.NE.ZERO ) THEN
  5083. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  5084. *
  5085. * w := sub( C ) * v
  5086. *
  5087. @@ -780,13 +781,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5088. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  5089. $ ICCOL2 )
  5090. IF( MYCOL.EQ.ICCOL1 )
  5091. - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  5092. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  5093. $ C( IOFFC1 ), 1 )
  5094. *
  5095. * sub( C ) := sub( C ) - w * v'
  5096. *
  5097. - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1,
  5098. - $ WORK, 1, C( IOFFC2 ), LDC )
  5099. + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ),
  5100. + $ 1, WORK, 1, C( IOFFC2 ), LDC )
  5101. END IF
  5102. *
  5103. END IF
  5104. @@ -810,18 +811,18 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5105. WORK( IPW ) = TAU( IIV )
  5106. CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  5107. $ WORK, IPW )
  5108. - TAULOC = DCONJG( TAU( IIV ) )
  5109. + TAULOC( 1 ) = DCONJG( TAU( IIV ) )
  5110. *
  5111. ELSE
  5112. *
  5113. IPW = NQV+1
  5114. CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1,
  5115. $ WORK, IPW, IVROW, MYCOL )
  5116. - TAULOC = DCONJG( WORK( IPW ) )
  5117. + TAULOC( 1 ) = DCONJG( WORK( IPW ) )
  5118. *
  5119. END IF
  5120. *
  5121. - IF( TAULOC.NE.ZERO ) THEN
  5122. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  5123. *
  5124. * w := sub( C ) * v
  5125. *
  5126. @@ -841,13 +842,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5127. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  5128. $ ICCOL2 )
  5129. IF( MYCOL.EQ.ICCOL1 )
  5130. - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  5131. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  5132. $ C( IOFFC1 ), 1 )
  5133. *
  5134. * sub( C ) := sub( C ) - w * v'
  5135. *
  5136. - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  5137. - $ 1, C( IOFFC2 ), LDC )
  5138. + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  5139. + $ WORK, 1, C( IOFFC2 ), LDC )
  5140. END IF
  5141. *
  5142. ELSE
  5143. @@ -866,17 +867,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5144. *
  5145. CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ),
  5146. $ 1 )
  5147. - TAULOC = DCONJG( TAU( JJV ) )
  5148. + TAULOC( 1 ) = DCONJG( TAU( JJV ) )
  5149. *
  5150. ELSE
  5151. *
  5152. CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1,
  5153. $ MYROW, IVCOL )
  5154. - TAULOC = DCONJG( TAULOC )
  5155. + TAULOC( 1 ) = DCONJG( TAULOC( 1 ) )
  5156. *
  5157. END IF
  5158. *
  5159. - IF( TAULOC.NE.ZERO ) THEN
  5160. + IF( TAULOC( 1 ).NE.ZERO ) THEN
  5161. *
  5162. * w := sub( C ) * v
  5163. *
  5164. @@ -895,13 +896,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C,
  5165. $ WORK( IPW ), MAX( 1, MPC2 ), RDEST,
  5166. $ ICCOL2 )
  5167. IF( MYCOL.EQ.ICCOL1 )
  5168. - $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1,
  5169. + $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1,
  5170. $ C( IOFFC1 ), 1 )
  5171. *
  5172. * sub( C ) := sub( C ) - w * v'
  5173. *
  5174. - CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK,
  5175. - $ 1, C( IOFFC2 ), LDC )
  5176. + CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1,
  5177. + $ WORK, 1, C( IOFFC2 ), LDC )
  5178. END IF
  5179. *
  5180. END IF
  5181. diff --git a/SRC/pzlattrs.f b/SRC/pzlattrs.f
  5182. index 819e476..5a54209 100644
  5183. --- a/SRC/pzlattrs.f
  5184. +++ b/SRC/pzlattrs.f
  5185. @@ -271,8 +271,9 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5186. $ JINC, JLAST, LDA, LDX, MB, MYCOL, MYROW, NB,
  5187. $ NPCOL, NPROW, RSRC
  5188. DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL,
  5189. - $ XBND, XJ, XMAX
  5190. + $ XBND, XJ
  5191. COMPLEX*16 CSUMJ, TJJS, USCAL, XJTMP, ZDUM
  5192. + DOUBLE PRECISION XMAX( 1 )
  5193. * ..
  5194. * .. External Functions ..
  5195. LOGICAL LSAME
  5196. @@ -391,11 +392,11 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5197. * Compute a bound on the computed solution vector to see if the
  5198. * Level 2 PBLAS routine PZTRSV can be used.
  5199. *
  5200. - XMAX = ZERO
  5201. + XMAX( 1 ) = ZERO
  5202. CALL PZAMAX( N, ZDUM, IMAX, X, IX, JX, DESCX, 1 )
  5203. - XMAX = CABS2( ZDUM )
  5204. + XMAX( 1 ) = CABS2( ZDUM )
  5205. CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, -1, -1 )
  5206. - XBND = XMAX
  5207. + XBND = XMAX( 1 )
  5208. *
  5209. IF( NOTRAN ) THEN
  5210. *
  5211. @@ -590,16 +591,16 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5212. *
  5213. * Use a Level 1 PBLAS solve, scaling intermediate results.
  5214. *
  5215. - IF( XMAX.GT.BIGNUM*HALF ) THEN
  5216. + IF( XMAX( 1 ).GT.BIGNUM*HALF ) THEN
  5217. *
  5218. * Scale X so that its components are less than or equal to
  5219. * BIGNUM in absolute value.
  5220. *
  5221. - SCALE = ( BIGNUM*HALF ) / XMAX
  5222. + SCALE = ( BIGNUM*HALF ) / XMAX( 1 )
  5223. CALL PZDSCAL( N, SCALE, X, IX, JX, DESCX, 1 )
  5224. - XMAX = BIGNUM
  5225. + XMAX( 1 ) = BIGNUM
  5226. ELSE
  5227. - XMAX = XMAX*TWO
  5228. + XMAX( 1 ) = XMAX( 1 )*TWO
  5229. END IF
  5230. *
  5231. IF( NOTRAN ) THEN
  5232. @@ -651,7 +652,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5233. CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
  5234. XJTMP = XJTMP*REC
  5235. SCALE = SCALE*REC
  5236. - XMAX = XMAX*REC
  5237. + XMAX( 1 ) = XMAX( 1 )*REC
  5238. END IF
  5239. END IF
  5240. * X( J ) = ZLADIV( X( J ), TJJS )
  5241. @@ -682,7 +683,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5242. CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
  5243. XJTMP = XJTMP*REC
  5244. SCALE = SCALE*REC
  5245. - XMAX = XMAX*REC
  5246. + XMAX( 1 ) = XMAX( 1 )*REC
  5247. END IF
  5248. * X( J ) = ZLADIV( X( J ), TJJS )
  5249. * XJ = CABS1( X( J ) )
  5250. @@ -706,7 +707,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5251. XJTMP = CONE
  5252. XJ = ONE
  5253. SCALE = ZERO
  5254. - XMAX = ZERO
  5255. + XMAX( 1 ) = ZERO
  5256. END IF
  5257. 90 CONTINUE
  5258. *
  5259. @@ -715,7 +716,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5260. *
  5261. IF( XJ.GT.ONE ) THEN
  5262. REC = ONE / XJ
  5263. - IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
  5264. + IF( CNORM( J ).GT.( BIGNUM-XMAX( 1 ) )*REC ) THEN
  5265. *
  5266. * Scale x by 1/(2*abs(x(j))).
  5267. *
  5268. @@ -724,7 +725,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5269. XJTMP = XJTMP*REC
  5270. SCALE = SCALE*REC
  5271. END IF
  5272. - ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
  5273. + ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX( 1 ) ) ) THEN
  5274. *
  5275. * Scale x by 1/2.
  5276. *
  5277. @@ -743,7 +744,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5278. CALL PZAXPY( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1, X,
  5279. $ IX, JX, DESCX, 1 )
  5280. CALL PZAMAX( J-1, ZDUM, IMAX, X, IX, JX, DESCX, 1 )
  5281. - XMAX = CABS1( ZDUM )
  5282. + XMAX( 1 ) = CABS1( ZDUM )
  5283. CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1,
  5284. $ -1, -1 )
  5285. END IF
  5286. @@ -757,7 +758,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5287. CALL PZAXPY( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1,
  5288. $ X, IX+J, JX, DESCX, 1 )
  5289. CALL PZAMAX( N-J, ZDUM, I, X, IX+J, JX, DESCX, 1 )
  5290. - XMAX = CABS1( ZDUM )
  5291. + XMAX( 1 ) = CABS1( ZDUM )
  5292. CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1,
  5293. $ -1, -1 )
  5294. END IF
  5295. @@ -785,7 +786,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5296. END IF
  5297. XJ = CABS1( XJTMP )
  5298. USCAL = DCMPLX( TSCAL )
  5299. - REC = ONE / MAX( XMAX, ONE )
  5300. + REC = ONE / MAX( XMAX( 1 ), ONE )
  5301. IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
  5302. *
  5303. * If x(j) could overflow, scale x by 1/(2*XMAX).
  5304. @@ -820,7 +821,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5305. CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
  5306. XJTMP = XJTMP*REC
  5307. SCALE = SCALE*REC
  5308. - XMAX = XMAX*REC
  5309. + XMAX( 1 ) = XMAX( 1 )*REC
  5310. END IF
  5311. END IF
  5312. *
  5313. @@ -924,7 +925,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5314. CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
  5315. XJTMP = XJTMP*REC
  5316. SCALE = SCALE*REC
  5317. - XMAX = XMAX*REC
  5318. + XMAX( 1 ) = XMAX( 1 )*REC
  5319. END IF
  5320. END IF
  5321. * X( J ) = ZLADIV( X( J ), TJJS )
  5322. @@ -945,7 +946,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5323. CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
  5324. XJTMP = XJTMP*REC
  5325. SCALE = SCALE*REC
  5326. - XMAX = XMAX*REC
  5327. + XMAX( 1 ) = XMAX( 1 )*REC
  5328. END IF
  5329. * X( J ) = ZLADIV( X( J ), TJJS )
  5330. XJTMP = ZLADIV( XJTMP, TJJS )
  5331. @@ -966,7 +967,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5332. END IF
  5333. XJTMP = CONE
  5334. SCALE = ZERO
  5335. - XMAX = ZERO
  5336. + XMAX( 1 ) = ZERO
  5337. END IF
  5338. 110 CONTINUE
  5339. ELSE
  5340. @@ -981,7 +982,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5341. X( IROWX ) = XJTMP
  5342. END IF
  5343. END IF
  5344. - XMAX = MAX( XMAX, CABS1( XJTMP ) )
  5345. + XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) )
  5346. 120 CONTINUE
  5347. *
  5348. ELSE
  5349. @@ -1004,7 +1005,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5350. END IF
  5351. XJ = CABS1( XJTMP )
  5352. USCAL = TSCAL
  5353. - REC = ONE / MAX( XMAX, ONE )
  5354. + REC = ONE / MAX( XMAX( 1 ), ONE )
  5355. IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
  5356. *
  5357. * If x(j) could overflow, scale x by 1/(2*XMAX).
  5358. @@ -1039,7 +1040,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5359. CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
  5360. XJTMP = XJTMP*REC
  5361. SCALE = SCALE*REC
  5362. - XMAX = XMAX*REC
  5363. + XMAX( 1 ) = XMAX( 1 )*REC
  5364. END IF
  5365. END IF
  5366. *
  5367. @@ -1145,7 +1146,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5368. CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
  5369. XJTMP = XJTMP*REC
  5370. SCALE = SCALE*REC
  5371. - XMAX = XMAX*REC
  5372. + XMAX( 1 ) = XMAX( 1 )*REC
  5373. END IF
  5374. END IF
  5375. * X( J ) = ZLADIV( X( J ), TJJS )
  5376. @@ -1164,7 +1165,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5377. CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 )
  5378. XJTMP = XJTMP*REC
  5379. SCALE = SCALE*REC
  5380. - XMAX = XMAX*REC
  5381. + XMAX( 1 ) = XMAX( 1 )*REC
  5382. END IF
  5383. * X( J ) = ZLADIV( X( J ), TJJS )
  5384. XJTMP = ZLADIV( XJTMP, TJJS )
  5385. @@ -1181,7 +1182,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5386. $ X( IROWX ) = CONE
  5387. XJTMP = CONE
  5388. SCALE = ZERO
  5389. - XMAX = ZERO
  5390. + XMAX( 1 ) = ZERO
  5391. END IF
  5392. 130 CONTINUE
  5393. ELSE
  5394. @@ -1194,7 +1195,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA,
  5395. IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) )
  5396. $ X( IROWX ) = XJTMP
  5397. END IF
  5398. - XMAX = MAX( XMAX, CABS1( XJTMP ) )
  5399. + XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) )
  5400. 140 CONTINUE
  5401. END IF
  5402. SCALE = SCALE / TSCAL
  5403. diff --git a/SRC/pzlawil.f b/SRC/pzlawil.f
  5404. index e89a9a3..7e502ef 100644
  5405. --- a/SRC/pzlawil.f
  5406. +++ b/SRC/pzlawil.f
  5407. @@ -124,11 +124,10 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  5408. $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT,
  5409. $ RSRC, UP
  5410. DOUBLE PRECISION S
  5411. - COMPLEX*16 CDUM, H11, H12, H21, H22, H33S, H44S, V1, V2,
  5412. - $ V3
  5413. + COMPLEX*16 CDUM, H22, H33S, H44S, V1, V2
  5414. * ..
  5415. * .. Local Arrays ..
  5416. - COMPLEX*16 BUF( 4 )
  5417. + COMPLEX*16 BUF( 4 ), H11( 1 ), H12( 1 ), H21( 1 ), V3( 1 )
  5418. * ..
  5419. * .. External Subroutines ..
  5420. EXTERNAL BLACS_GRIDINFO, INFOG2L, ZGERV2D, ZGESD2D
  5421. @@ -181,18 +180,18 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  5422. IF( NPCOL.GT.1 ) THEN
  5423. CALL ZGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT )
  5424. ELSE
  5425. - V3 = A( ( ICOL-2 )*LDA+IROW )
  5426. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  5427. END IF
  5428. IF( NUM.GT.1 ) THEN
  5429. CALL ZGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT )
  5430. - H11 = BUF( 1 )
  5431. - H21 = BUF( 2 )
  5432. - H12 = BUF( 3 )
  5433. + H11( 1 ) = BUF( 1 )
  5434. + H21( 1 ) = BUF( 2 )
  5435. + H12( 1 ) = BUF( 3 )
  5436. H22 = BUF( 4 )
  5437. ELSE
  5438. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  5439. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  5440. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  5441. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  5442. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  5443. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  5444. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  5445. END IF
  5446. END IF
  5447. @@ -225,20 +224,20 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  5448. IF( NUM.GT.1 ) THEN
  5449. CALL ZGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT )
  5450. ELSE
  5451. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  5452. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  5453. END IF
  5454. IF( NPROW.GT.1 ) THEN
  5455. CALL ZGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL )
  5456. ELSE
  5457. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  5458. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  5459. END IF
  5460. IF( NPCOL.GT.1 ) THEN
  5461. CALL ZGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT )
  5462. ELSE
  5463. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  5464. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  5465. END IF
  5466. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  5467. - V3 = A( ( ICOL-2 )*LDA+IROW )
  5468. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  5469. END IF
  5470. END IF
  5471. IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) )
  5472. @@ -247,24 +246,24 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V )
  5473. IF( MODKM1.GT.1 ) THEN
  5474. CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
  5475. $ IROW, ICOL, RSRC, JSRC )
  5476. - H11 = A( ( ICOL-3 )*LDA+IROW-2 )
  5477. - H21 = A( ( ICOL-3 )*LDA+IROW-1 )
  5478. - H12 = A( ( ICOL-2 )*LDA+IROW-2 )
  5479. + H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 )
  5480. + H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 )
  5481. + H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 )
  5482. H22 = A( ( ICOL-2 )*LDA+IROW-1 )
  5483. - V3 = A( ( ICOL-2 )*LDA+IROW )
  5484. + V3( 1 ) = A( ( ICOL-2 )*LDA+IROW )
  5485. END IF
  5486. *
  5487. - H44S = H44 - H11
  5488. - H33S = H33 - H11
  5489. - V1 = ( H33S*H44S-H43H34 ) / H21 + H12
  5490. - V2 = H22 - H11 - H33S - H44S
  5491. - S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3 )
  5492. + H44S = H44 - H11( 1 )
  5493. + H33S = H33 - H11( 1 )
  5494. + V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 )
  5495. + V2 = H22 - H11( 1 ) - H33S - H44S
  5496. + S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3( 1 ) )
  5497. V1 = V1 / S
  5498. V2 = V2 / S
  5499. - V3 = V3 / S
  5500. + V3( 1 ) = V3( 1 ) / S
  5501. V( 1 ) = V1
  5502. V( 2 ) = V2
  5503. - V( 3 ) = V3
  5504. + V( 3 ) = V3( 1 )
  5505. *
  5506. RETURN
  5507. *
  5508. diff --git a/SRC/pztrevc.f b/SRC/pztrevc.f
  5509. index 0536475..3b27286 100644
  5510. --- a/SRC/pztrevc.f
  5511. +++ b/SRC/pztrevc.f
  5512. @@ -218,11 +218,12 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  5513. $ ITMP2, J, K, KI, LDT, LDVL, LDVR, LDW, MB,
  5514. $ MYCOL, MYROW, NB, NPCOL, NPROW, RSRC
  5515. REAL SELF
  5516. - DOUBLE PRECISION OVFL, REMAXD, SCALE, SMIN, SMLNUM, ULP, UNFL
  5517. + DOUBLE PRECISION OVFL, REMAXD, SCALE, SMLNUM, ULP, UNFL
  5518. COMPLEX*16 CDUM, REMAXC, SHIFT
  5519. * ..
  5520. * .. Local Arrays ..
  5521. INTEGER DESCW( DLEN_ )
  5522. + DOUBLE PRECISION SMIN( 1 )
  5523. * ..
  5524. * .. External Functions ..
  5525. LOGICAL LSAME
  5526. @@ -355,13 +356,13 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  5527. $ GO TO 70
  5528. END IF
  5529. *
  5530. - SMIN = ZERO
  5531. + SMIN( 1 ) = ZERO
  5532. SHIFT = CZERO
  5533. CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL,
  5534. $ IROW, ICOL, ITMP1, ITMP2 )
  5535. IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
  5536. SHIFT = T( ( ICOL-1 )*LDT+IROW )
  5537. - SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
  5538. + SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
  5539. END IF
  5540. CALL DGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 )
  5541. CALL ZGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 )
  5542. @@ -396,8 +397,9 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  5543. IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
  5544. T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -
  5545. $ SHIFT
  5546. - IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) THEN
  5547. - T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN )
  5548. + IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) )
  5549. + $ THEN
  5550. + T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN( 1 ) )
  5551. END IF
  5552. END IF
  5553. 50 CONTINUE
  5554. @@ -467,13 +469,13 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  5555. $ GO TO 110
  5556. END IF
  5557. *
  5558. - SMIN = ZERO
  5559. + SMIN( 1 ) = ZERO
  5560. SHIFT = CZERO
  5561. CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL,
  5562. $ IROW, ICOL, ITMP1, ITMP2 )
  5563. IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
  5564. SHIFT = T( ( ICOL-1 )*LDT+IROW )
  5565. - SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
  5566. + SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM )
  5567. END IF
  5568. CALL DGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 )
  5569. CALL ZGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 )
  5570. @@ -507,8 +509,8 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL,
  5571. IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
  5572. T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) -
  5573. $ SHIFT
  5574. - IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN )
  5575. - $ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN )
  5576. + IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) )
  5577. + $ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN( 1 ) )
  5578. END IF
  5579. 90 CONTINUE
  5580. *
  5581. From 189c84001bcd564296a475c5c757afc9f337e828 Mon Sep 17 00:00:00 2001
  5582. From: =?UTF-8?q?Tiziano=20M=C3=BCller?= <tiziano.mueller@chem.uzh.ch>
  5583. Date: Thu, 25 Jun 2020 18:37:34 +0200
  5584. Subject: [PATCH 2/2] use -std=legacy for tests with GCC-10+
  5585. ---
  5586. BLACS/TESTING/CMakeLists.txt | 10 +++++++---
  5587. PBLAS/TESTING/CMakeLists.txt | 7 ++++---
  5588. PBLAS/TIMING/CMakeLists.txt | 5 +++--
  5589. TESTING/EIG/CMakeLists.txt | 3 +++
  5590. TESTING/LIN/CMakeLists.txt | 4 ++++
  5591. 5 files changed, 21 insertions(+), 8 deletions(-)
  5592. diff --git a/BLACS/TESTING/CMakeLists.txt b/BLACS/TESTING/CMakeLists.txt
  5593. index d8846b5..4e91ac2 100644
  5594. --- a/BLACS/TESTING/CMakeLists.txt
  5595. +++ b/BLACS/TESTING/CMakeLists.txt
  5596. @@ -1,10 +1,14 @@
  5597. -set(FTestObj
  5598. +set(FTestObj
  5599. blacstest.f btprim.f tools.f)
  5600. +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
  5601. + set_source_files_properties(blacstest.f PROPERTIES COMPILE_FLAGS "-std=legacy")
  5602. +endif()
  5603. +
  5604. add_executable(xFbtest ${FTestObj})
  5605. target_link_libraries(xFbtest scalapack)
  5606. -set(CTestObj
  5607. +set(CTestObj
  5608. Cbt.c)
  5609. set_property(
  5610. @@ -46,4 +50,4 @@ add_test(xFbtest
  5611. -DRUNTIMEDIR=${CMAKE_RUNTIME_OUTPUT_DIRECTORY}
  5612. -DSOURCEDIR=${CMAKE_CURRENT_SOURCE_DIR}
  5613. -P ${CMAKE_CURRENT_SOURCE_DIR}/runtest.cmake
  5614. - )
  5615. \ No newline at end of file
  5616. + )
  5617. diff --git a/PBLAS/TESTING/CMakeLists.txt b/PBLAS/TESTING/CMakeLists.txt
  5618. index e60f5e4..ee77091 100644
  5619. --- a/PBLAS/TESTING/CMakeLists.txt
  5620. +++ b/PBLAS/TESTING/CMakeLists.txt
  5621. @@ -10,7 +10,7 @@ set (zpbtcom pzblastst.f dlamch.f ${pbtcom})
  5622. set_property(
  5623. SOURCE ${PblasErrorHandler}
  5624. - APPEND PROPERTY COMPILE_DEFINITIONS TestingPblas
  5625. + APPEND PROPERTY COMPILE_DEFINITIONS TestingPblas
  5626. )
  5627. set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${SCALAPACK_BINARY_DIR}/PBLAS/TESTING)
  5628. @@ -74,5 +74,6 @@ add_test(dpb3tst ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./dpb3tst)
  5629. add_test(cpb3tst ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./cpb3tst)
  5630. add_test(zpb3tst ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./zpb3tst)
  5631. -
  5632. -
  5633. +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
  5634. + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory
  5635. +endif()
  5636. diff --git a/PBLAS/TIMING/CMakeLists.txt b/PBLAS/TIMING/CMakeLists.txt
  5637. index 763330f..208bbc3 100644
  5638. --- a/PBLAS/TIMING/CMakeLists.txt
  5639. +++ b/PBLAS/TIMING/CMakeLists.txt
  5640. @@ -74,5 +74,6 @@ add_test(dpb3tim ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./dpb3tim)
  5641. add_test(cpb3tim ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./cpb3tim)
  5642. add_test(zpb3tim ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./zpb3tim)
  5643. -
  5644. -
  5645. +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
  5646. + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory
  5647. +endif()
  5648. diff --git a/TESTING/EIG/CMakeLists.txt b/TESTING/EIG/CMakeLists.txt
  5649. index 97c7036..19a1f34 100644
  5650. --- a/TESTING/EIG/CMakeLists.txt
  5651. +++ b/TESTING/EIG/CMakeLists.txt
  5652. @@ -97,3 +97,6 @@ target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
  5653. target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
  5654. target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
  5655. +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
  5656. + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory
  5657. +endif()
  5658. diff --git a/TESTING/LIN/CMakeLists.txt b/TESTING/LIN/CMakeLists.txt
  5659. index 55a53e9..65f169b 100644
  5660. --- a/TESTING/LIN/CMakeLists.txt
  5661. +++ b/TESTING/LIN/CMakeLists.txt
  5662. @@ -110,3 +110,7 @@ target_link_libraries(xsls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
  5663. target_link_libraries(xdls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
  5664. target_link_libraries(xcls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
  5665. target_link_libraries(xzls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
  5666. +
  5667. +if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
  5668. + set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory
  5669. +endif()