SRC\pzlahqr.f
#lines: 2550   size: 109 Kb   creation: 29/03/2007 01:44:42   last modification: 08/05/2008 18:38:15   attribute: ARCH    Find   Reload   
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:
1086:
1087:
1088:
1089:
1090:
1091:
1092:
1093:
1094:
1095:
1096:
1097:
1098:
1099:
1100:
1101:
1102:
1103:
1104:
1105:
1106:
1107:
1108:
1109:
1110:
1111:
1112:
1113:
1114:
1115:
1116:
1117:
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
1134:
1135:
1136:
1137:
1138:
1139:
1140:
1141:
1142:
1143:
1144:
1145:
1146:
1147:
1148:
1149:
1150:
1151:
1152:
1153:
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
1170:
1171:
1172:
1173:
1174:
1175:
1176:
1177:
1178:
1179:
1180:
1181:
1182:
1183:
1184:
1185:
1186:
1187:
1188:
1189:
1190:
1191:
1192:
1193:
1194:
1195:
1196:
1197:
1198:
1199:
1200:
1201:
1202:
1203:
1204:
1205:
1206:
1207:
1208:
1209:
1210:
1211:
1212:
1213:
1214:
1215:
1216:
1217:
1218:
1219:
1220:
1221:
1222:
1223:
1224:
1225:
1226:
1227:
1228:
1229:
1230:
1231:
1232:
1233:
1234:
1235:
1236:
1237:
1238:
1239:
1240:
1241:
1242:
1243:
1244:
1245:
1246:
1247:
1248:
1249:
1250:
1251:
1252:
1253:
1254:
1255:
1256:
1257:
1258:
1259:
1260:
1261:
1262:
1263:
1264:
1265:
1266:
1267:
1268:
1269:
1270:
1271:
1272:
1273:
1274:
1275:
1276:
1277:
1278:
1279:
1280:
1281:
1282:
1283:
1284:
1285:
1286:
1287:
1288:
1289:
1290:
1291:
1292:
1293:
1294:
1295:
1296:
1297:
1298:
1299:
1300:
1301:
1302:
1303:
1304:
1305:
1306:
1307:
1308:
1309:
1310:
1311:
1312:
1313:
1314:
1315:
1316:
1317:
1318:
1319:
1320:
1321:
1322:
1323:
1324:
1325:
1326:
1327:
1328:
1329:
1330:
1331:
1332:
1333:
1334:
1335:
1336:
1337:
1338:
1339:
1340:
1341:
1342:
1343:
1344:
1345:
1346:
1347:
1348:
1349:
1350:
1351:
1352:
1353:
1354:
1355:
1356:
1357:
1358:
1359:
1360:
1361:
1362:
1363:
1364:
1365:
1366:
1367:
1368:
1369:
1370:
1371:
1372:
1373:
1374:
1375:
1376:
1377:
1378:
1379:
1380:
1381:
1382:
1383:
1384:
1385:
1386:
1387:
1388:
1389:
1390:
1391:
1392:
1393:
1394:
1395:
1396:
1397:
1398:
1399:
1400:
1401:
1402:
1403:
1404:
1405:
1406:
1407:
1408:
1409:
1410:
1411:
1412:
1413:
1414:
1415:
1416:
1417:
1418:
1419:
1420:
1421:
1422:
1423:
1424:
1425:
1426:
1427:
1428:
1429:
1430:
1431:
1432:
1433:
1434:
1435:
1436:
1437:
1438:
1439:
1440:
1441:
1442:
1443:
1444:
1445:
1446:
1447:
1448:
1449:
1450:
1451:
1452:
1453:
1454:
1455:
1456:
1457:
1458:
1459:
1460:
1461:
1462:
1463:
1464:
1465:
1466:
1467:
1468:
1469:
1470:
1471:
1472:
1473:
1474:
1475:
1476:
1477:
1478:
1479:
1480:
1481:
1482:
1483:
1484:
1485:
1486:
1487:
1488:
1489:
1490:
1491:
1492:
1493:
1494:
1495:
1496:
1497:
1498:
1499:
1500:
1501:
1502:
1503:
1504:
1505:
1506:
1507:
1508:
1509:
1510:
1511:
1512:
1513:
1514:
1515:
1516:
1517:
1518:
1519:
1520:
1521:
1522:
1523:
1524:
1525:
1526:
1527:
1528:
1529:
1530:
1531:
1532:
1533:
1534:
1535:
1536:
1537:
1538:
1539:
1540:
1541:
1542:
1543:
1544:
1545:
1546:
1547:
1548:
1549:
1550:
1551:
1552:
1553:
1554:
1555:
1556:
1557:
1558:
1559:
1560:
1561:
1562:
1563:
1564:
1565:
1566:
1567:
1568:
1569:
1570:
1571:
1572:
1573:
1574:
1575:
1576:
1577:
1578:
1579:
1580:
1581:
1582:
1583:
1584:
1585:
1586:
1587:
1588:
1589:
1590:
1591:
1592:
1593:
1594:
1595:
1596:
1597:
1598:
1599:
1600:
1601:
1602:
1603:
1604:
1605:
1606:
1607:
1608:
1609:
1610:
1611:
1612:
1613:
1614:
1615:
1616:
1617:
1618:
1619:
1620:
1621:
1622:
1623:
1624:
1625:
1626:
1627:
1628:
1629:
1630:
1631:
1632:
1633:
1634:
1635:
1636:
1637:
1638:
1639:
1640:
1641:
1642:
1643:
1644:
1645:
1646:
1647:
1648:
1649:
1650:
1651:
1652:
1653:
1654:
1655:
1656:
1657:
1658:
1659:
1660:
1661:
1662:
1663:
1664:
1665:
1666:
1667:
1668:
1669:
1670:
1671:
1672:
1673:
1674:
1675:
1676:
1677:
1678:
1679:
1680:
1681:
1682:
1683:
1684:
1685:
1686:
1687:
1688:
1689:
1690:
1691:
1692:
1693:
1694:
1695:
1696:
1697:
1698:
1699:
1700:
1701:
1702:
1703:
1704:
1705:
1706:
1707:
1708:
1709:
1710:
1711:
1712:
1713:
1714:
1715:
1716:
1717:
1718:
1719:
1720:
1721:
1722:
1723:
1724:
1725:
1726:
1727:
1728:
1729:
1730:
1731:
1732:
1733:
1734:
1735:
1736:
1737:
1738:
1739:
1740:
1741:
1742:
1743:
1744:
1745:
1746:
1747:
1748:
1749:
1750:
1751:
1752:
1753:
1754:
1755:
1756:
1757:
1758:
1759:
1760:
1761:
1762:
1763:
1764:
1765:
1766:
1767:
1768:
1769:
1770:
1771:
1772:
1773:
1774:
1775:
1776:
1777:
1778:
1779:
1780:
1781:
1782:
1783:
1784:
1785:
1786:
1787:
1788:
1789:
1790:
1791:
1792:
1793:
1794:
1795:
1796:
1797:
1798:
1799:
1800:
1801:
1802:
1803:
1804:
1805:
1806:
1807:
1808:
1809:
1810:
1811:
1812:
1813:
1814:
1815:
1816:
1817:
1818:
1819:
1820:
1821:
1822:
1823:
1824:
1825:
1826:
1827:
1828:
1829:
1830:
1831:
1832:
1833:
1834:
1835:
1836:
1837:
1838:
1839:
1840:
1841:
1842:
1843:
1844:
1845:
1846:
1847:
1848:
1849:
1850:
1851:
1852:
1853:
1854:
1855:
1856:
1857:
1858:
1859:
1860:
1861:
1862:
1863:
1864:
1865:
1866:
1867:
1868:
1869:
1870:
1871:
1872:
1873:
1874:
1875:
1876:
1877:
1878:
1879:
1880:
1881:
1882:
1883:
1884:
1885:
1886:
1887:
1888:
1889:
1890:
1891:
1892:
1893:
1894:
1895:
1896:
1897:
1898:
1899:
1900:
1901:
1902:
1903:
1904:
1905:
1906:
1907:
1908:
1909:
1910:
1911:
1912:
1913:
1914:
1915:
1916:
1917:
1918:
1919:
1920:
1921:
1922:
1923:
1924:
1925:
1926:
1927:
1928:
1929:
1930:
1931:
1932:
1933:
1934:
1935:
1936:
1937:
1938:
1939:
1940:
1941:
1942:
1943:
1944:
1945:
1946:
1947:
1948:
1949:
1950:
1951:
1952:
1953:
1954:
1955:
1956:
1957:
1958:
1959:
1960:
1961:
1962:
1963:
1964:
1965:
1966:
1967:
1968:
1969:
1970:
1971:
1972:
1973:
1974:
1975:
1976:
1977:
1978:
1979:
1980:
1981:
1982:
1983:
1984:
1985:
1986:
1987:
1988:
1989:
1990:
1991:
1992:
1993:
1994:
1995:
1996:
1997:
1998:
1999:
2000:
2001:
2002:
2003:
2004:
2005:
2006:
2007:
2008:
2009:
2010:
2011:
2012:
2013:
2014:
2015:
2016:
2017:
2018:
2019:
2020:
2021:
2022:
2023:
2024:
2025:
2026:
2027:
2028:
2029:
2030:
2031:
2032:
2033:
2034:
2035:
2036:
2037:
2038:
2039:
2040:
2041:
2042:
2043:
2044:
2045:
2046:
2047:
2048:
2049:
2050:
2051:
2052:
2053:
2054:
2055:
2056:
2057:
2058:
2059:
2060:
2061:
2062:
2063:
2064:
2065:
2066:
2067:
2068:
2069:
2070:
2071:
2072:
2073:
2074:
2075:
2076:
2077:
2078:
2079:
2080:
2081:
2082:
2083:
2084:
2085:
2086:
2087:
2088:
2089:
2090:
2091:
2092:
2093:
2094:
2095:
2096:
2097:
2098:
2099:
2100:
2101:
2102:
2103:
2104:
2105:
2106:
2107:
2108:
2109:
2110:
2111:
2112:
2113:
2114:
2115:
2116:
2117:
2118:
2119:
2120:
2121:
2122:
2123:
2124:
2125:
2126:
2127:
2128:
2129:
2130:
2131:
2132:
2133:
2134:
2135:
2136:
2137:
2138:
2139:
2140:
2141:
2142:
2143:
2144:
2145:
2146:
2147:
2148:
2149:
2150:
2151:
2152:
2153:
2154:
2155:
2156:
2157:
2158:
2159:
2160:
2161:
2162:
2163:
2164:
2165:
2166:
2167:
2168:
2169:
2170:
2171:
2172:
2173:
2174:
2175:
2176:
2177:
2178:
2179:
2180:
2181:
2182:
2183:
2184:
2185:
2186:
2187:
2188:
2189:
2190:
2191:
2192:
2193:
2194:
2195:
2196:
2197:
2198:
2199:
2200:
2201:
2202:
2203:
2204:
2205:
2206:
2207:
2208:
2209:
2210:
2211:
2212:
2213:
2214:
2215:
2216:
2217:
2218:
2219:
2220:
2221:
2222:
2223:
2224:
2225:
2226:
2227:
2228:
2229:
2230:
2231:
2232:
2233:
2234:
2235:
2236:
2237:
2238:
2239:
2240:
2241:
2242:
2243:
2244:
2245:
2246:
2247:
2248:
2249:
2250:
2251:
2252:
2253:
2254:
2255:
2256:
2257:
2258:
2259:
2260:
2261:
2262:
2263:
2264:
2265:
2266:
2267:
2268:
2269:
2270:
2271:
2272:
2273:
2274:
2275:
2276:
2277:
2278:
2279:
2280:
2281:
2282:
2283:
2284:
2285:
2286:
2287:
2288:
2289:
2290:
2291:
2292:
2293:
2294:
2295:
2296:
2297:
2298:
2299:
2300:
2301:
2302:
2303:
2304:
2305:
2306:
2307:
2308:
2309:
2310:
2311:
2312:
2313:
2314:
2315:
2316:
2317:
2318:
2319:
2320:
2321:
2322:
2323:
2324:
2325:
2326:
2327:
2328:
2329:
2330:
2331:
2332:
2333:
2334:
2335:
2336:
2337:
2338:
2339:
2340:
2341:
2342:
2343:
2344:
2345:
2346:
2347:
2348:
2349:
2350:
2351:
2352:
2353:
2354:
2355:
2356:
2357:
2358:
2359:
2360:
2361:
2362:
2363:
2364:
2365:
2366:
2367:
2368:
2369:
2370:
2371:
2372:
2373:
2374:
2375:
2376:
2377:
2378:
2379:
2380:
2381:
2382:
2383:
2384:
2385:
2386:
2387:
2388:
2389:
2390:
2391:
2392:
2393:
2394:
2395:
2396:
2397:
2398:
2399:
2400:
2401:
2402:
2403:
2404:
2405:
2406:
2407:
2408:
2409:
2410:
2411:
2412:
2413:
2414:
2415:
2416:
2417:
2418:
2419:
2420:
2421:
2422:
2423:
2424:
2425:
2426:
2427:
2428:
2429:
2430:
2431:
2432:
2433:
2434:
2435:
2436:
2437:
2438:
2439:
2440:
2441:
2442:
2443:
2444:
2445:
2446:
2447:
2448:
2449:
2450:
2451:
2452:
2453:
2454:
2455:
2456:
2457:
2458:
2459:
2460:
2461:
2462:
2463:
2464:
2465:
2466:
2467:
2468:
2469:
2470:
2471:
2472:
2473:
2474:
2475:
2476:
2477:
2478:
2479:
2480:
2481:
2482:
2483:
2484:
2485:
2486:
2487:
2488:
2489:
2490:
2491:
2492:
2493:
2494:
2495:
2496:
2497:
2498:
2499:
2500:
2501:
2502:
2503:
2504:
2505:
2506:
2507:
2508:
2509:
2510:
2511:
2512:
2513:
2514:
2515:
2516:
2517:
2518:
2519:
2520:
2521:
2522:
2523:
2524:
2525:
2526:
2527:
2528:
2529:
2530:
2531:
2532:
2533:
2534:
2535:
2536:
2537:
2538:
2539:
2540:
2541:
2542:
2543:
2544:
2545:
2546:
2547:
2548:
2549:
2550:
 
      SUBROUTINE PZLAHQR( WANTT, WANTZ, N, ILO, IHI, A, DESCA, W, ILOZ,
     $                    IHIZ, Z, DESCZ, WORK, LWORK, IWORK, ILWORK,
     $                    INFO )
*
*  -- ScaLAPACK routine (version 1.7.3) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     1.7.3: March   22, 2006
*            modification suggested by Mark Fahey and Greg Henry
*     1.7.0: July    31, 2001
*
*     .. Scalar Arguments ..
      LOGICAL            WANTT, WANTZ
      INTEGER            IHI, IHIZ, ILO, ILOZ, ILWORK, INFO, LWORK, N
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * ), DESCZ( * ), IWORK( * )
      COMPLEX*16         A( * ), W( * ), WORK( * ), Z( * )
*     ..
*
*  Purpose
*  =======
*
*  PZLAHQR is an auxiliary routine used to find the Schur decomposition
*    and or eigenvalues of a matrix already in Hessenberg form from
*    cols ILO to IHI.
*  If Z = I, and WANTT=WANTZ=.TRUE., H gets replaced with Z'HZ,
*    with Z'Z=I, and H in Schur form.
*
*  Notes
*  =====
*
*  Each global data object is described by an associated description
*  vector.  This vector stores the information required to establish
*  the mapping between an object element and its corresponding process
*  and memory location.
*
*  Let A be a generic term for any 2D block cyclicly distributed array.
*  Such a global array has an associated description vector DESCA.
*  In the following comments, the character _ should be read as
*  "of the global array".
*
*  NOTATION        STORED IN      EXPLANATION
*  --------------- -------------- --------------------------------------
*  DTYPE_A(global) DESCA( DTYPE_ )The descriptor type.  In this case,
*                                 DTYPE_A = 1.
*  CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
*                                 the BLACS process grid A is distribu-
*                                 ted over. The context itself is glo-
*                                 bal, but the handle (the integer
*                                 value) may vary.
*  M_A    (global) DESCA( M_ )    The number of rows in the global
*                                 array A.
*  N_A    (global) DESCA( N_ )    The number of columns in the global
*                                 array A.
*  MB_A   (global) DESCA( MB_ )   The blocking factor used to distribute
*                                 the rows of the array.
*  NB_A   (global) DESCA( NB_ )   The blocking factor used to distribute
*                                 the columns of the array.
*  RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
*                                 row of the array A is distributed.
*  CSRC_A (global) DESCA( CSRC_ ) The process column over which the
*                                 first column of the array A is
*                                 distributed.
*  LLD_A  (local)  DESCA( LLD_ )  The leading dimension of the local
*                                 array.  LLD_A >= MAX(1,LOCp(M_A)).
*
*  Let K be the number of rows or columns of a distributed matrix,
*  and assume that its process grid has dimension p x q.
*  LOCp( K ) denotes the number of elements of K that a process
*  would receive if K were distributed over the p processes of its
*  process column.
*  Similarly, LOCq( K ) denotes the number of elements of K that a
*  process would receive if K were distributed over the q processes of
*  its process row.
*  The values of LOCp() and LOCq() may be determined via a call to the
*  ScaLAPACK tool function, NUMROC:
*          LOCp( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
*          LOCq( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
*  An upper bound for these quantities may be computed by:
*          LOCp( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
*          LOCq( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
*
*  Arguments
*  =========
*
*  WANTT   (global input) LOGICAL
*          = .TRUE. : the full Schur form T is required;
*          = .FALSE.: only eigenvalues are required.
*
*  WANTZ   (global input) LOGICAL
*          = .TRUE. : the matrix of Schur vectors Z is required;
*          = .FALSE.: Schur vectors are not required.
*
*  N       (global input) INTEGER
*          The order of the Hessenberg matrix A (and Z if WANTZ).
*          N >= 0.
*
*  ILO     (global input) INTEGER
*  IHI     (global input) INTEGER
*          It is assumed that A is already upper quasi-triangular in
*          rows and columns IHI+1:N, and that A(ILO,ILO-1) = 0 (unless
*          ILO = 1). PZLAHQR works primarily with the Hessenberg
*          submatrix in rows and columns ILO to IHI, but applies
*          transformations to all of H if WANTT is .TRUE..
*          1 <= ILO <= max(1,IHI); IHI <= N.
*
*  A       (global input/output) COMPLEX*16 array, dimension
*          (DESCA(LLD_),*)
*          On entry, the upper Hessenberg matrix A.
*          On exit, if WANTT is .TRUE., A is upper triangular in rows
*          and columns ILO:IHI.  If WANTT is .FALSE., the contents of
*          A are unspecified on exit.
*
*  DESCA   (global and local input) INTEGER array of dimension DLEN_.
*          The array descriptor for the distributed matrix A.
*
*  W      (global replicated output) COMPLEX*16 array, dimension (N)
*          The computed eigenvalues ILO to IHI are stored in the
*          corresponding elements of W.  If WANTT is .TRUE., the
*          eigenvalues are stored in the same order as on the diagonal
*          of the Schur form returned in A.  A may be returned with
*          larger diagonal blocks until the next release.
*
*  ILOZ    (global input) INTEGER
*  IHIZ    (global input) INTEGER
*          Specify the rows of Z to which transformations must be
*          applied if WANTZ is .TRUE..
*          1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
*
*  Z       (global input/output) COMPLEX*16 array.
*          If WANTZ is .TRUE., on entry Z must contain the current
*          matrix Z of transformations accumulated by PZHSEQR, and on
*          exit Z has been updated; transformations are applied only to
*          the submatrix Z(ILOZ:IHIZ,ILO:IHI).
*          If WANTZ is .FALSE., Z is not referenced.
*
*  DESCZ   (global and local input) INTEGER array of dimension DLEN_.
*          The array descriptor for the distributed matrix Z.
*
*  WORK    (local output) COMPLEX*16 array of size LWORK
*          (Unless LWORK=-1, in which case WORK must be at least size 1)
*
*  LWORK   (local input) INTEGER
*          WORK(LWORK) is a local array and LWORK is assumed big enough
*          so that LWORK >= 3*N +
*                MAX( 2*MAX(DESCZ(LLD_),DESCA(LLD_)) + 2*LOCq(N),
*                     7*Ceil(N/HBL)/LCM(NPROW,NPCOL)) +
*                MAX( 2*N, (8*LCM(NPROW,NPCOL)+2)**2 )
*          If LWORK=-1, then WORK(1) gets set to the above number and
*          the code returns immediately.
*
*  IWORK   (global and local input) INTEGER array of size ILWORK
*          This will hold some of the IBLK integer arrays.
*          This is held as a place holder for a future release.
*          Currently unreferenced.
*
*  ILWORK  (local input) INTEGER
*          This will hold the size of the IWORK array.
*          This is held as a place holder for a future release.
*          Currently unreferenced.
*
*  INFO    (global output) INTEGER
*          < 0: parameter number -INFO incorrect or inconsistent
*          = 0: successful exit
*          > 0: PZLAHQR failed to compute all the eigenvalues ILO to IHI
*               in a total of 30*(IHI-ILO+1) iterations; if INFO = i,
*               elements i+1:ihi of W contains those eigenvalues
*               which have been successfully computed.
*
*  Logic:
*       This algorithm is very similar to DLAHQR.  Unlike DLAHQR,
*       instead of sending one double shift through the largest
*       unreduced submatrix, this algorithm sends multiple double shifts
*       and spaces them apart so that there can be parallelism across
*       several processor row/columns.  Another critical difference is
*       that this algorithm aggregrates multiple transforms together in
*       order to apply them in a block fashion.
*
*  Important Local Variables:
*       IBLK = The maximum number of bulges that can be computed.
*           Currently fixed.  Future releases this won't be fixed.
*       HBL  = The square block size (HBL=DESCA(MB_)=DESCA(NB_))
*       ROTN = The number of transforms to block together
*       NBULGE = The number of bulges that will be attempted on the
*           current submatrix.
*       IBULGE = The current number of bulges started.
*       K1(*),K2(*) = The current bulge loops from K1(*) to K2(*).
*
*  Subroutines:
*       From LAPACK, this routine calls:
*           ZLAHQR     -> Serial QR used to determine shifts and
*                         eigenvalues
*           ZLARFG     -> Determine the Householder transforms
*
*       This ScaLAPACK, this routine calls:
*           PZLACONSB  -> To determine where to start each iteration
*           ZLAMSH     -> Sends multiple shifts through a small
*                         submatrix to see how the consecutive
*                         subdiagonals change (if PZLACONSB indicates
*                         we can start a run in the middle)
*           PZLAWIL    -> Given the shift, get the transformation
*           PZLACP3    -> Parallel array to local replicated array copy
*                         & back.
*           ZLAREF     -> Row/column reflector applier.  Core routine
*                         here.
*           PZLASMSUB  -> Finds negligible subdiagonal elements.
*
*  Current Notes and/or Restrictions:
*       1.) This code requires the distributed block size to be square
*           and at least six (6); unlike simpler codes like LU, this
*           algorithm is extremely sensitive to block size.  Unwise
*           choices of too small a block size can lead to bad
*           performance.
*       2.) This code requires A and Z to be distributed identically
*           and have identical contxts.  A future version may allow Z to
*           have a different contxt to 1D row map it to all nodes (so no
*           communication on Z is necessary.)
*       3.) This code does not currently block the initial transforms
*           so that none of the rows or columns for any bulge are
*           completed until all are started.  To offset pipeline
*           start-up it is recommended that at least 2*LCM(NPROW,NPCOL)
*           bulges are used (if possible)
*       4.) The maximum number of bulges currently supported is fixed at
*           32.  In future versions this will be limited only by the
*           incoming WORK and IWORK array.
*       5.) The matrix A must be in upper Hessenberg form.  If elements
*           below the subdiagonal are nonzero, the resulting transforms
*           may be nonsimilar.  This is also true with the LAPACK
*           routine ZLAHQR.
*       6.) For this release, this code has only been tested for
*           RSRC_=CSRC_=0, but it has been written for the general case.
*       7.) Currently, all the eigenvalues are distributed to all the
*           nodes.  Future releases will probably distribute the
*           eigenvalues by the column partitioning.
*       8.) The internals of this routine are subject to change.
*       9.) To optimize this for your architecture, try tuning ZLAREF.
*       10.) This code has only been tested for WANTZ = .TRUE. and may
*           behave unpredictably for WANTZ set to .FALSE.
*
*  Further Details
*  ===============
*
*  Contributed by Mark Fahey, June, 2000.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DT_,
     $                   LLD_, MB_, M_, NB_, N_, RSRC_
      PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1,
     $                     CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
     $                     RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
      DOUBLE PRECISION   RONE
      PARAMETER          ( RONE = 1.0D+0 )
      COMPLEX*16         ZERO, ONE
      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ),
     $                   ONE = ( 1.0D+0, 0.0D+0 ) )
      DOUBLE PRECISION   CONST
      PARAMETER          ( CONST = 1.50D+0 )
      INTEGER            IBLK
      PARAMETER          ( IBLK = 32 )
*     ..
*     .. Local Scalars ..
      LOGICAL            SKIP
      INTEGER            CONTXT, DOWN, HBL, I, I1, I2, IAFIRST, IBULGE,
     $                   ICBUF, ICOL, ICOL1, ICOL2, IDIA, IERR, II,
     $                   IRBUF, IROW, IROW1, IROW2, ISPEC, ISTART,
     $                   ISTARTCOL, ISTARTROW, ISTOP, ISUB, ISUP,
     $                   ITERMAX, ITMP1, ITMP2, ITN, ITS, IZBUF, J,
     $                   JAFIRST, JBLK, JJ, K, KI, L, LCMRC, LDA, LDZ,
     $                   LEFT, LIHIH, LIHIZ, LILOH, LILOZ, LOCALI1,
     $                   LOCALI2, LOCALK, LOCALM, M, MODKM1, MYCOL,
     $                   MYROW, NBULGE, NH, NODE, NPCOL, NPROW, NQ, NR,
     $                   NUM, NZ, RIGHT, ROTN, UP, VECSIDX
      DOUBLE PRECISION   CS, OVFL, S, SMLNUM, ULP, UNFL
      COMPLEX*16         CDUM, H10, H11, H22, H33, H43H34, H44, SN, SUM,
     $                   T1, T1COPY, T2, T3, V1SAVE, V2, V2SAVE, V3,
     $                   V3SAVE
*     ..
*     .. Local Arrays ..
      INTEGER            ICURCOL( IBLK ), ICURROW( IBLK ), K1( IBLK ),
     $                   K2( IBLK ), KCOL( IBLK ), KP2COL( IBLK ),
     $                   KP2ROW( IBLK ), KROW( IBLK )
      COMPLEX*16         S1( 2*IBLK, 2*IBLK ), SMALLA( 6, 6, IBLK ),
     $                   VCOPY( 3 )
*     ..
*     .. External Functions ..
      INTEGER            ILCM, NUMROC
      DOUBLE PRECISION   PDLAMCH
      EXTERNAL           ILCM, NUMROC, PDLAMCH
*     ..
*     .. External Subroutines ..
      EXTERNAL           BLACS_GRIDINFO, IGAMN2D, IGEBR2D, IGEBS2D,
     $                   INFOG1L, INFOG2L, PDLABAD, PXERBLA, PZLACONSB,
     $                   PZLACP3, PZLASMSUB, PZLAWIL, PZROT, ZCOPY,
     $                   ZGEBR2D, ZGEBS2D, ZGERV2D, ZGESD2D, ZGSUM2D,
     $                   ZLAHQR2, ZLAMSH, ZLANV2, ZLAREF, ZLARFG
*     ..
*     .. Intrinsic Functions ..
*
      INTRINSIC          ABS, DBLE, DCONJG, DIMAG, MAX, MIN, MOD
*     ..
*     .. Statement Functions ..
      DOUBLE PRECISION   CABS1
*     ..
*     .. Statement Function definitions ..
      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
*     ..
*     .. Executable Statements ..
*
      INFO = 0
*
      ITERMAX = 30*( IHI-ILO+1 )
      IF( N.EQ.0 )
     $   RETURN
*
*     NODE (IAFIRST,JAFIRST) OWNS A(1,1)
*
      HBL = DESCA( MB_ )
      CONTXT = DESCA( CTXT_ )
      LDA = DESCA( LLD_ )
      IAFIRST = DESCA( RSRC_ )
      JAFIRST = DESCA( CSRC_ )
      LDZ = DESCZ( LLD_ )
      CALL BLACS_GRIDINFO( CONTXT, NPROW, NPCOL, MYROW, MYCOL )
      NODE = MYROW*NPCOL + MYCOL
      NUM = NPROW*NPCOL
      LEFT = MOD( MYCOL+NPCOL-1, NPCOL )
      RIGHT = MOD( MYCOL+1, NPCOL )
      UP = MOD( MYROW+NPROW-1, NPROW )
      DOWN = MOD( MYROW+1, NPROW )
      LCMRC = ILCM( NPROW, NPCOL )
      IF( ( NPROW.LE.3 ) .OR. ( NPCOL.LE.3 ) ) THEN
         SKIP = .TRUE.
      ELSE
         SKIP = .FALSE.
      END IF
*
*     Determine the number of columns we have so we can check workspace
*
      NQ = NUMROC( N, HBL, MYCOL, JAFIRST, NPCOL )
      JJ = N / HBL
      IF( JJ*HBL.LT.N )
     $   JJ = JJ + 1
      JJ = 7*JJ / LCMRC
      JJ = 3*N + MAX( 2*MAX( LDA, LDZ )+2*NQ, JJ )
      JJ = JJ + MAX( 2*N, ( 8*LCMRC+2 )**2 )
      IF( LWORK.EQ.-1 ) THEN
         WORK( 1 ) = JJ
         RETURN
      END IF
      IF( LWORK.LT.JJ ) THEN
         INFO = -14
      END IF
      IF( DESCZ( CTXT_ ).NE.DESCA( CTXT_ ) ) THEN
         INFO = -( 1300+CTXT_ )
      END IF
      IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
         INFO = -( 700+NB_ )
      END IF
      IF( DESCZ( MB_ ).NE.DESCZ( NB_ ) ) THEN
         INFO = -( 1300+NB_ )
      END IF
      IF( DESCA( MB_ ).NE.DESCZ( MB_ ) ) THEN
         INFO = -( 1300+MB_ )
      END IF
      IF( ( DESCA( RSRC_ ).NE.0 ) .OR. ( DESCA( CSRC_ ).NE.0 ) ) THEN
         INFO = -( 700+RSRC_ )
      END IF
      IF( ( DESCZ( RSRC_ ).NE.0 ) .OR. ( DESCZ( CSRC_ ).NE.0 ) ) THEN
         INFO = -( 1300+RSRC_ )
      END IF
      IF( ( ILO.GT.N ) .OR. ( ILO.LT.1 ) ) THEN
         INFO = -4
      END IF
      IF( ( IHI.GT.N ) .OR. ( IHI.LT.1 ) ) THEN
         INFO = -5
      END IF
      IF( HBL.LT.5 ) THEN
         INFO = -( 700+MB_ )
      END IF
      CALL IGAMN2D( CONTXT, 'ALL', ' ', 1, 1, INFO, 1, ITMP1, ITMP2, -1,
     $              -1, -1 )
      IF( INFO.LT.0 ) THEN
         CALL PXERBLA( CONTXT, 'PZLAHQR', -INFO )
         RETURN
      END IF
*
*     Set work array indices
*
      VECSIDX = 0
      IDIA = 3*N
      ISUB = 3*N
      ISUP = 3*N
      IRBUF = 3*N
      ICBUF = 3*N
      IZBUF = 5*N
*
*     Find a value for ROTN
*
      ROTN = HBL / 3
      ROTN = MIN( ROTN, HBL-2 )
      ROTN = MAX( ROTN, 1 )
*
      IF( ILO.EQ.IHI ) THEN
         CALL INFOG2L( ILO, ILO, DESCA, NPROW, NPCOL, MYROW, MYCOL,
     $                 IROW, ICOL, II, JJ )
         IF( ( MYROW.EQ.II ) .AND. ( MYCOL.EQ.JJ ) ) THEN
            W( ILO ) = A( ( ICOL-1 )*LDA+IROW )
         ELSE
            W( ILO ) = ZERO
         END IF
         RETURN
      END IF
*
      NH = IHI - ILO + 1
      NZ = IHIZ - ILOZ + 1
*
      CALL INFOG1L( ILOZ, HBL, NPROW, MYROW, IAFIRST, LILOZ, LIHIZ )
      LIHIZ = NUMROC( IHIZ, HBL, MYROW, IAFIRST, NPROW )
*
*     Set machine-dependent constants for the stopping criterion.
*     If NORM(H) <= SQRT(OVFL), overflow should not occur.
*
      UNFL = PDLAMCH( CONTXT, 'SAFE MINIMUM' )
      OVFL = RONE / UNFL
      CALL PDLABAD( CONTXT, UNFL, OVFL )
      ULP = PDLAMCH( CONTXT, 'PRECISION' )
      SMLNUM = UNFL*( NH / ULP )
*
*     I1 and I2 are the indices of the first row and last column of H
*     to which transformations must be applied. If eigenvalues only are
*     being computed, I1 and I2 are set inside the main loop.
*
      IF( WANTT ) THEN
         I1 = 1
         I2 = N
      END IF
*
*     ITN is the total number of QR iterations allowed.
*
      ITN = ITERMAX
*
*     The main loop begins here. I is the loop index and decreases from
*     IHI to ILO in steps of our schur block size (<=2*IBLK). Each
*     iteration of the loop works  with the active submatrix in rows
*     and columns L to I.   Eigenvalues I+1 to IHI have already
*     converged. Either L = ILO or the global A(L,L-1) is negligible
*     so that the matrix splits.
*
      I = IHI
   10 CONTINUE
      L = ILO
      IF( I.LT.ILO )
     $   GO TO 570
*
*     Perform QR iterations on rows and columns ILO to I until a
*     submatrix of order 1 or 2 splits off at the bottom because a
*     subdiagonal element has become negligible.
*
      DO 540 ITS = 0, ITN
*
*        Look for a single small subdiagonal element.
*
         CALL PZLASMSUB( A, DESCA, I, L, K, SMLNUM, WORK( IRBUF+1 ),
     $                   LWORK-IRBUF )
         L = K
*
         IF( L.GT.ILO ) THEN
*
*           H(L,L-1) is negligible
*
            CALL INFOG2L( L, L-1, DESCA, NPROW, NPCOL, MYROW, MYCOL,
     $                    IROW, ICOL, ITMP1, ITMP2 )
            IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
               A( ( ICOL-1 )*LDA+IROW ) = ZERO
            END IF
            WORK( ISUB+L-1 ) = ZERO
         END IF
*
*        Exit from loop if a submatrix of order 1 or 2 has split off.
*
         IF( WANTT ) THEN
*           For Schur form, use 2x2 blocks
            IF( L.GE.I-1 ) THEN
               GO TO 550
            END IF
         ELSE
*           If we don't want the Schur form, use bigger blocks.
            IF( L.GE.I-( 2*IBLK-1 ) ) THEN
               GO TO 550
            END IF
         END IF
*
*        Now the active submatrix is in rows and columns L to I. If
*        eigenvalues only are being computed, only the active submatrix
*        need be transformed.
*
         IF( .NOT.WANTT ) THEN
            I1 = L
            I2 = I
         END IF
*
*        Copy submatrix of size 2*JBLK and prepare to do generalized
*           Wilkinson shift or an exceptional shift
*
         JBLK = MIN( IBLK, ( ( I-L+1 ) / 2 )-1 )
         IF( JBLK.GT.LCMRC ) THEN
*
*           Make sure it's divisible by LCM (we want even workloads!)
*
            JBLK = JBLK - MOD( JBLK, LCMRC )
         END IF
         JBLK = MIN( JBLK, 2*LCMRC )
         JBLK = MAX( JBLK, 1 )
*
         CALL PZLACP3( 2*JBLK, I-2*JBLK+1, A, DESCA, S1, 2*IBLK, -1, -1,
     $                 0 )
         IF( ( ITS.EQ.20 .OR. ITS.EQ.40 ) .AND. ( JBLK.GT.1 ) ) THEN
*
*           Exceptional shift.
*
            DO 20 II = 2*JBLK, 2, -1
               S1( II, II ) = CONST*( CABS1( S1( II, II ) )+
     $                        CABS1( S1( II, II-1 ) ) )
               S1( II, II-1 ) = ZERO
               S1( II-1, II ) = ZERO
   20       CONTINUE
            S1( 1, 1 ) = CONST*CABS1( S1( 1, 1 ) )
         ELSE
            CALL ZLAHQR2( .FALSE., .FALSE., 2*JBLK, 1, 2*JBLK, S1,
     $                   2*IBLK, WORK( IRBUF+1 ), 1, 2*JBLK, Z, LDZ,
     $                   IERR )
*
*           Prepare to use Wilkinson's double shift
*
            H44 = S1( 2*JBLK, 2*JBLK )
            H33 = S1( 2*JBLK-1, 2*JBLK-1 )
            H43H34 = S1( 2*JBLK-1, 2*JBLK )*S1( 2*JBLK, 2*JBLK-1 )
*
         END IF
*
*        Look for two consecutive small subdiagonal elements:
*           PZLACONSB is the routine that does this.
*
         CALL PZLACONSB( A, DESCA, I, L, M, H44, H33, H43H34,
     $                   WORK( IRBUF+1 ), LWORK-IRBUF )
*
*        Double-shift QR step
*
*        NBULGE is the number of bulges that will be attempted
*
         ISTOP = MIN( M+ROTN-1-MOD( M-( M / HBL )*HBL-1, ROTN ), I-2 )
         ISTOP = MIN( ISTOP, M+HBL-3-MOD( M-1, HBL ) )
         ISTOP = MIN( ISTOP, I2-2 )
         ISTOP = MAX( ISTOP, M )
         NBULGE = ( I-1-ISTOP ) / HBL
*
*        Do not exceed maximum determined.
*
         NBULGE = MIN( NBULGE, JBLK )
         IF( NBULGE.GT.LCMRC ) THEN
*
*           Make sure it's divisible by LCM (we want even workloads!)
*
            NBULGE = NBULGE - MOD( NBULGE, LCMRC )
         END IF
         NBULGE = MAX( NBULGE, 1 )
*
*        If we are starting in the middle because of consecutive small
*           subdiagonal elements, we need to see how many bulges we
*           can send through without breaking the consecutive small
*           subdiagonal property.
*
         IF( ( NBULGE.GT.1 ) .AND. ( M.GT.L ) ) THEN
*
*           Copy a chunk of elements from global A(M-1:,M-1:)
*
            CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL,
     $                    IROW1, ICOL1, ITMP1, ITMP2 )
            II = MIN( 4*NBULGE+2, N-M+2 )
            CALL PZLACP3( II, M-1, A, DESCA, WORK( IRBUF+1 ), II, ITMP1,
     $                    ITMP2, 0 )
            IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
*
*              Find a new NBULGE based on the bulges we have.
*
               CALL ZLAMSH( S1, 2*IBLK, NBULGE, JBLK, WORK( IRBUF+1 ),
     $                      II, II, ULP )
               IF( NUM.GT.1 ) THEN
                  CALL IGEBS2D( CONTXT, 'ALL', ' ', 1, 1, NBULGE, 1 )
               END IF
            ELSE
*
*              Everyone needs to receive the new NBULGE
*
               CALL IGEBR2D( CONTXT, 'ALL', ' ', 1, 1, NBULGE, 1, ITMP1,
     $                       ITMP2 )
            END IF
         END IF
*
*        IBULGE is the number of bulges going so far
*
         IBULGE = 1
*
*        "A" row defs : main row transforms from LOCALK to LOCALI2
*
         CALL INFOG1L( M, HBL, NPCOL, MYCOL, JAFIRST, ITMP1, LOCALK )
         LOCALK = NQ
         CALL INFOG1L( 1, HBL, NPCOL, MYCOL, JAFIRST, ICOL1, LOCALI2 )
         LOCALI2 = NUMROC( I2, HBL, MYCOL, JAFIRST, NPCOL )
*
*        "A" col defs : main col transforms from LOCALI1 to LOCALM
*
         CALL INFOG1L( I1, HBL, NPROW, MYROW, IAFIRST, LOCALI1, ICOL1 )
         CALL INFOG1L( 1, HBL, NPROW, MYROW, IAFIRST, LOCALM, ICOL1 )
         ICOL1 = NUMROC( MIN( M+3, I ), HBL, MYROW, IAFIRST, NPROW )
*
*        Which row & column will start the bulges
*
         ISTARTROW = MOD( ( M+1 ) / HBL, NPROW ) + IAFIRST
         ISTARTCOL = MOD( ( M+1 ) / HBL, NPCOL ) + JAFIRST
*
         CALL INFOG1L( M, HBL, NPROW, MYROW, IAFIRST, II, ITMP2 )
         CALL INFOG1L( M, HBL, NPCOL, MYCOL, JAFIRST, JJ, ITMP2 )
         CALL INFOG1L( 1, HBL, NPROW, MYROW, IAFIRST, ISTOP,
     $                 KP2ROW( 1 ) )
         KP2ROW( 1 ) = NUMROC( M+2, HBL, MYROW, IAFIRST, NPROW )
         CALL INFOG1L( 1, HBL, NPCOL, MYCOL, JAFIRST, ISTOP,
     $                 KP2COL( 1 ) )
         KP2COL( 1 ) = NUMROC( M+2, HBL, MYCOL, JAFIRST, NPCOL )
*
*        Set all values for bulges.  All bulges are stored in
*          intermediate steps as loops over KI.  Their current "task"
*          over the global M to I-1 values is always K1(KI) to K2(KI).
*          However, because there are many bulges, K1(KI) & K2(KI) might
*          go past that range while later bulges (KI+1,KI+2,etc..) are
*          finishing up.  Even if ROTN=1, in order to minimize border
*          communication sometimes K1(KI)=HBL-2 & K2(KI)=HBL-1 so both
*          border messages can be handled at once.
*
*        Rules:
*              If MOD(K1(KI)-1,HBL) < HBL-2 then MOD(K2(KI)-1,HBL)<HBL-2
*              If MOD(K1(KI)-1,HBL) = HBL-1 then MOD(K2(KI)-1,HBL)=HBL-1
*              K2(KI)-K1(KI) <= ROTN
*
*        We first hit a border when MOD(K1(KI)-1,HBL)=HBL-2 and we hit
*        it again when MOD(K1(KI)-1,HBL)=HBL-1.
*
         DO 30 KI = 1, NBULGE
            K1( KI ) = M
            ISTOP = MIN( M+ROTN-1-MOD( M-( M / HBL )*HBL-1, ROTN ),
     $              I-2 )
            ISTOP = MIN( ISTOP, M+HBL-3-MOD( M-1, HBL ) )
            ISTOP = MIN( ISTOP, I2-2 )
            ISTOP = MAX( ISTOP, M )
            IF( ( MOD( M-1, HBL ).EQ.HBL-2 ) .AND.
     $          ( ISTOP.LT.MIN( I-2, I2-2 ) ) ) THEN
               ISTOP = ISTOP + 1
            END IF
            K2( KI ) = ISTOP
            ICURROW( KI ) = ISTARTROW
            ICURCOL( KI ) = ISTARTCOL
            KROW( KI ) = II
            KCOL( KI ) = JJ
            IF( KI.GT.1 )
     $         KP2ROW( KI ) = KP2ROW( 1 )
            IF( KI.GT.1 )
     $         KP2COL( KI ) = KP2COL( 1 )
   30    CONTINUE
*
*        Get first transform on node who owns M+2,M+2
*
         DO 31 ITMP1 = 1, 3
            VCOPY(ITMP1) = ZERO
   31    CONTINUE
         ITMP1 = ISTARTROW
         ITMP2 = ISTARTCOL
         CALL PZLAWIL( ITMP1, ITMP2, M, A, DESCA, H44, H33, H43H34,
     $                 VCOPY )
         V1SAVE = VCOPY( 1 )
         V2SAVE = VCOPY( 2 )
         V3SAVE = VCOPY( 3 )
*
*        The main implicit shift Francis loops over the bulges starts
*           here!
*
         IF( K2( IBULGE ).LE.I-1 ) THEN
   40       CONTINUE
            IF( ( K1( IBULGE ).GE.M+5 ) .AND. ( IBULGE.LT.NBULGE ) )
     $           THEN
               IF( ( MOD( K2( IBULGE )+2, HBL ).EQ.MOD( K2( IBULGE+1 )+
     $             2, HBL ) ) .AND. ( K1( 1 ).LE.I-1 ) ) THEN
                  H44 = S1( 2*JBLK-2*IBULGE, 2*JBLK-2*IBULGE )
                  H33 = S1( 2*JBLK-2*IBULGE-1, 2*JBLK-2*IBULGE-1 )
                  H43H34 = S1( 2*JBLK-2*IBULGE-1, 2*JBLK-2*IBULGE )*
     $                     S1( 2*JBLK-2*IBULGE, 2*JBLK-2*IBULGE-1 )
                  ITMP1 = ISTARTROW
                  ITMP2 = ISTARTCOL
                  CALL PZLAWIL( ITMP1, ITMP2, M, A, DESCA, H44, H33,
     $                          H43H34, VCOPY )
                  V1SAVE = VCOPY( 1 )
                  V2SAVE = VCOPY( 2 )
                  V3SAVE = VCOPY( 3 )
                  IBULGE = IBULGE + 1
               END IF
            END IF
*
*        When we hit a border, there are row and column transforms that
*          overlap over several processors and the code gets very
*          "congested."  As a remedy, when we first hit a border, a 6x6
*          *local* matrix is generated on one node (called SMALLA) and
*          work is done on that.  At the end of the border, the data is
*          passed back and everything stays a lot simpler.
*
            DO 120 KI = 1, IBULGE
*
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
               K = ISTART
               MODKM1 = MOD( K-1, HBL )
               IF( ( MODKM1.GE.HBL-2 ) .AND. ( K.LE.I-1 ) ) THEN
                  DO 81 ITMP1 = 1, 6
                     DO 82 ITMP2 = 1, 6
                        SMALLA(ITMP1, ITMP2, KI) = ZERO
   82                CONTINUE
   81             CONTINUE
                  IF( ( MODKM1.EQ.HBL-2 ) .AND. ( K.LT.I-1 ) ) THEN
*
*                 Copy 6 elements from global A(K-1:K+4,K-1:K+4)
*
                     ITMP1 = ICURROW( KI )
                     ITMP2 = ICURCOL( KI )
                     CALL PZLACP3( MIN( 6, N-K+2 ), K-1, A, DESCA,
     $                             SMALLA( 1, 1, KI ), 6, ITMP1, ITMP2,
     $                             0 )
                  END IF
                  IF( MODKM1.EQ.HBL-1 ) THEN
*
*                 Copy 6 elements from global A(K-2:K+3,K-2:K+3)
*
                     CALL INFOG2L( K+1, K+1, DESCA, NPROW, NPCOL, MYROW,
     $                             MYCOL, IROW1, ICOL1, ITMP1, ITMP2 )
                     CALL PZLACP3( MIN( 6, N-K+3 ), K-2, A, DESCA,
     $                             SMALLA( 1, 1, KI ), 6, ITMP1, ITMP2,
     $                             0 )
                  END IF
               END IF
*
*
*           ZLAHQR used to have a single row application and a single
*              column application to H.  Here we do something a little
*              more clever.  We break each transformation down into 3
*              parts:
*                  1.) The minimum amount of work it takes to determine
*                        a group of ROTN transformations (this is on
*                        the critical path.) (Loops 50-120)
*                  (the data is broadcast now: loops 180-240)
*                  2.) The small work it takes so that each of the rows
*                        and columns is at the same place.  For example,
*                        all ROTN row transforms are all complete
*                        through some column TMP.  (Loops 250-260)
*                  3.) The majority of the row and column transforms
*                        are then applied in a block fashion.
*                        (row transforms are in loops 280-380)
*                        (col transforms are in loops 400-540)
*
*           Each of these three parts are further subdivided into 3
*           parts:
*               A.) Work at the start of a border when
*                       MOD(ISTART-1,HBL) = HBL-2
*               B.) Work at the end of a border when
*                       MOD(ISTART-1,HBL) = HBL-1
*               C.) Work in the middle of the block when
*                       MOD(ISTART-1,HBL) < HBL-2
*
*           Further optimization is met with the boolean SKIP.  A border
*              communication can be broken into several parts for
*              efficient parallelism:
*                 Loop over all the bulges, just sending the data out
*                 Loop over all the bulges, just doing the work
*                 Loop over all the bulges, just sending the data back.
*
*
               IF( ( MYROW.EQ.ICURROW( KI ) ) .AND.
     $             ( MYCOL.EQ.ICURCOL( KI ) ) .AND.
     $             ( MODKM1.EQ.HBL-2 ) .AND.
     $             ( ISTART.LT.MIN( I-1, ISTOP+1 ) ) ) THEN
                  K = ISTART
                  NR = MIN( 3, I-K+1 )
                  IF( K.GT.M ) THEN
                     CALL ZCOPY( NR, SMALLA( 2, 1, KI ), 1, VCOPY, 1 )
                  ELSE
                     VCOPY( 1 ) = V1SAVE
                     VCOPY( 2 ) = V2SAVE
                     VCOPY( 3 ) = V3SAVE
                  END IF
                  CALL ZLARFG( NR, VCOPY( 1 ), VCOPY( 2 ), 1, T1COPY )
                  IF( K.GT.M ) THEN
                     SMALLA( 2, 1, KI ) = VCOPY( 1 )
                     SMALLA( 3, 1, KI ) = ZERO
                     IF( K.LT.I-1 )
     $                  SMALLA( 4, 1, KI ) = ZERO
                  ELSE IF( M.GT.L ) THEN
*
*                 Following differs in comparison to pdlahqr.
*
                     SMALLA( 2, 1, KI ) = SMALLA( 2, 1, KI ) -
     $                                    DCONJG( T1COPY )*
     $                                    SMALLA( 2, 1, KI )
                  END IF
                  V2 = VCOPY( 2 )
                  T2 = T1COPY*V2
                  WORK( VECSIDX+( K-1 )*3+1 ) = VCOPY( 2 )
                  WORK( VECSIDX+( K-1 )*3+2 ) = VCOPY( 3 )
                  WORK( VECSIDX+( K-1 )*3+3 ) = T1COPY
                  IF( NR.EQ.3 ) THEN
*
*                    Do some work so next step is ready...
*
                     T1 = T1COPY
                     V3 = VCOPY( 3 )
                     T3 = T1*V3
                     ITMP1 = MIN( 6, I2+2-K )
                     ITMP2 = MAX( I1-K+2, 1 )
                     DO 50 J = 2, ITMP1
                        SUM = DCONJG( T1 )*SMALLA( 2, J, KI ) +
     $                        DCONJG( T2 )*SMALLA( 3, J, KI ) +
     $                        DCONJG( T3 )*SMALLA( 4, J, KI )
                        SMALLA( 2, J, KI ) = SMALLA( 2, J, KI ) - SUM
                        SMALLA( 3, J, KI ) = SMALLA( 3, J, KI ) - SUM*V2
                        SMALLA( 4, J, KI ) = SMALLA( 4, J, KI ) - SUM*V3
   50                CONTINUE
                     DO 60 J = ITMP2, 5
                        SUM = T1*SMALLA( J, 2, KI ) +
     $                        T2*SMALLA( J, 3, KI ) +
     $                        T3*SMALLA( J, 4, KI )
                        SMALLA( J, 2, KI ) = SMALLA( J, 2, KI ) - SUM
                        SMALLA( J, 3, KI ) = SMALLA( J, 3, KI ) -
     $                                       SUM*DCONJG( V2 )
                        SMALLA( J, 4, KI ) = SMALLA( J, 4, KI ) -
     $                                       SUM*DCONJG( V3 )
   60                CONTINUE
                  END IF
               END IF
*
               IF( ( MOD( ISTOP-1, HBL ).EQ.HBL-1 ) .AND.
     $             ( MYROW.EQ.ICURROW( KI ) ) .AND.
     $             ( MYCOL.EQ.ICURCOL( KI ) ) .AND.
     $             ( ISTART.LE.MIN( I, ISTOP ) ) ) THEN
                  K = ISTOP
                  NR = MIN( 3, I-K+1 )
                  IF( K.GT.M ) THEN
                     CALL ZCOPY( NR, SMALLA( 3, 2, KI ), 1, VCOPY, 1 )
                  ELSE
                     VCOPY( 1 ) = V1SAVE
                     VCOPY( 2 ) = V2SAVE
                     VCOPY( 3 ) = V3SAVE
                  END IF
                  CALL ZLARFG( NR, VCOPY( 1 ), VCOPY( 2 ), 1, T1COPY )
                  IF( K.GT.M ) THEN
                     SMALLA( 3, 2, KI ) = VCOPY( 1 )
                     SMALLA( 4, 2, KI ) = ZERO
                     IF( K.LT.I-1 )
     $                  SMALLA( 5, 2, KI ) = ZERO
*
*                    Set a subdiagonal to zero now if it's possible
*
                     IF( ( K-2.GT.M ) .AND. ( MOD( K-1, HBL ).GT.1 ) )
     $                    THEN
                        H11 = SMALLA( 1, 1, KI )
                        H10 = SMALLA( 2, 1, KI )
                        H22 = SMALLA( 2, 2, KI )
                        S = CABS1( H11 ) + CABS1( H22 )
                        IF( CABS1( H10 ).LE.MAX( ULP*S, SMLNUM ) ) THEN
                           SMALLA( 2, 1, KI ) = ZERO
                        END IF
                     END IF
                  ELSE IF( M.GT.L ) THEN
*
*                 Following differs in comparison to pdlahqr.
*
                     SMALLA( 3, 2, KI ) = SMALLA( 3, 2, KI ) -
     $                                    DCONJG( T1COPY )*
     $                                    SMALLA( 3, 2, KI )
                  END IF
                  V2 = VCOPY( 2 )
                  T2 = T1COPY*V2
                  WORK( VECSIDX+( K-1 )*3+1 ) = VCOPY( 2 )
                  WORK( VECSIDX+( K-1 )*3+2 ) = VCOPY( 3 )
                  WORK( VECSIDX+( K-1 )*3+3 ) = T1COPY
                  IF( NR.EQ.3 ) THEN
*
*                    Do some work so next step is ready...
*
                     T1 = T1COPY
                     V3 = VCOPY( 3 )
                     T3 = T1*V3
                     ITMP1 = MIN( 6, I2-K+3 )
                     ITMP2 = MAX( I1-K+3, 1 )
                     DO 70 J = 3, ITMP1
                        SUM = DCONJG( T1 )*SMALLA( 3, J, KI ) +
     $                        DCONJG( T2 )*SMALLA( 4, J, KI ) +
     $                        DCONJG( T3 )*SMALLA( 5, J, KI )
                        SMALLA( 3, J, KI ) = SMALLA( 3, J, KI ) - SUM
                        SMALLA( 4, J, KI ) = SMALLA( 4, J, KI ) - SUM*V2
                        SMALLA( 5, J, KI ) = SMALLA( 5, J, KI ) - SUM*V3
   70                CONTINUE
                     DO 80 J = ITMP2, 6
                        SUM = T1*SMALLA( J, 3, KI ) +
     $                        T2*SMALLA( J, 4, KI ) +
     $                        T3*SMALLA( J, 5, KI )
                        SMALLA( J, 3, KI ) = SMALLA( J, 3, KI ) - SUM
                        SMALLA( J, 4, KI ) = SMALLA( J, 4, KI ) -
     $                                       SUM*DCONJG( V2 )
                        SMALLA( J, 5, KI ) = SMALLA( J, 5, KI ) -
     $                                       SUM*DCONJG( V3 )
   80                CONTINUE
                  END IF
               END IF
*
               IF( ( MODKM1.EQ.0 ) .AND. ( ISTART.LE.I-1 ) .AND.
     $             ( MYROW.EQ.ICURROW( KI ) ) .AND.
     $             ( RIGHT.EQ.ICURCOL( KI ) ) ) THEN
*
*              (IROW1,ICOL1) is (I,J)-coordinates of H(ISTART,ISTART)
*
                  IROW1 = KROW( KI )
                  ICOL1 = KCOL( KI )
*
*                 The ELSE part of this IF needs updated VCOPY, this
*                 was not necessary in PDLAHQR.
*
                  IF( ISTART.GT.M ) THEN
                     VCOPY( 1 ) = SMALLA( 4, 3, KI )
                     VCOPY( 2 ) = SMALLA( 5, 3, KI )
                     VCOPY( 3 ) = SMALLA( 6, 3, KI )
                     NR = MIN( 3, I-ISTART+1 )
                     CALL ZLARFG( NR, VCOPY( 1 ), VCOPY( 2 ), 1,
     $                            T1COPY )
                     A( ( ICOL1-2 )*LDA+IROW1 ) = VCOPY( 1 )
                     A( ( ICOL1-2 )*LDA+IROW1+1 ) = ZERO
                     IF( ISTART.LT.I-1 ) THEN
                        A( ( ICOL1-2 )*LDA+IROW1+2 ) = ZERO
                     END IF
                  ELSE
*
*                    If NPCOL.NE.1 THEN we need updated VCOPY.
*
                     NR = MIN( 3, I-ISTART+1 )
                     IF( NPCOL.EQ.1 ) THEN
                        VCOPY( 1 ) = V1SAVE
                        VCOPY( 2 ) = V2SAVE
                        VCOPY( 3 ) = V3SAVE
                     ELSE
*
*                    Get updated VCOPY from RIGHT
*
                        CALL ZGERV2D( CONTXT, 3, 1, VCOPY, 3, MYROW,
     $                                RIGHT )
                     END IF
                     CALL ZLARFG( NR, VCOPY( 1 ), VCOPY( 2 ), 1,
     $                            T1COPY )
                     IF( M.GT.L ) THEN
*
*                    Following differs in comparison to pdlahqr.
*
                        A( ( ICOL1-2 )*LDA+IROW1 ) = A( ( ICOL1-2 )*LDA+
     $                     IROW1 )*DCONJG( ONE-T1COPY )
                     END IF
                  END IF
               END IF
*
               IF( ( MYROW.EQ.ICURROW( KI ) ) .AND.
     $             ( MYCOL.EQ.ICURCOL( KI ) ) .AND.
     $             ( ( ( MODKM1.EQ.HBL-2 ) .AND. ( ISTART.EQ.I-
     $             1 ) ) .OR. ( ( MODKM1.LT.HBL-2 ) .AND. ( ISTART.LE.I-
     $             1 ) ) ) ) THEN
*
*              (IROW1,ICOL1) is (I,J)-coordinates of H(ISTART,ISTART)
*
                  IROW1 = KROW( KI )
                  ICOL1 = KCOL( KI )
                  DO 110 K = ISTART, ISTOP
*
*                    Create and do these transforms
*
                     NR = MIN( 3, I-K+1 )
                     IF( K.GT.M ) THEN
                        IF( MOD( K-1, HBL ).EQ.0 ) THEN
                           VCOPY( 1 ) = SMALLA( 4, 3, KI )
                           VCOPY( 2 ) = SMALLA( 5, 3, KI )
                           VCOPY( 3 ) = SMALLA( 6, 3, KI )
                        ELSE
                           VCOPY( 1 ) = A( ( ICOL1-2 )*LDA+IROW1 )
                           VCOPY( 2 ) = A( ( ICOL1-2 )*LDA+IROW1+1 )
                           IF( NR.EQ.3 ) THEN
                              VCOPY( 3 ) = A( ( ICOL1-2 )*LDA+IROW1+2 )
                           END IF
                        END IF
                     ELSE
                        VCOPY( 1 ) = V1SAVE
                        VCOPY( 2 ) = V2SAVE
                        VCOPY( 3 ) = V3SAVE
                     END IF
*
*                    Must send uptodate copy of VCOPY to left.
*
                     IF( NPCOL.GT.1 .AND. ISTART.LE.M .AND.
     $                   MOD( K-1, HBL ).EQ.0 ) THEN
                        CALL ZGESD2D( CONTXT, 3, 1, VCOPY, 3, MYROW,
     $                                LEFT )
                     END IF
                     CALL ZLARFG( NR, VCOPY( 1 ), VCOPY( 2 ), 1,
     $                            T1COPY )
                     IF( K.GT.M ) THEN
                        IF( MOD( K-1, HBL ).GT.0 ) THEN
                           A( ( ICOL1-2 )*LDA+IROW1 ) = VCOPY( 1 )
                           A( ( ICOL1-2 )*LDA+IROW1+1 ) = ZERO
                           IF( K.LT.I-1 ) THEN
                              A( ( ICOL1-2 )*LDA+IROW1+2 ) = ZERO
                           END IF
*
*                       Set a subdiagonal to zero now if it's possible
*
                           IF( ( IROW1.GT.2 ) .AND. ( ICOL1.GT.2 ) .AND.
     $                         ( K-2.GT.M ) .AND. ( MOD( K-1,
     $                         HBL ).GT.1 ) ) THEN
                              H11 = A( ( ICOL1-3 )*LDA+IROW1-2 )
                              H10 = A( ( ICOL1-3 )*LDA+IROW1-1 )
                              H22 = A( ( ICOL1-2 )*LDA+IROW1-1 )
                              S = CABS1( H11 ) + CABS1( H22 )
                              IF( CABS1( H10 ).LE.MAX( ULP*S, SMLNUM ) )
     $                             THEN
                                 A( ( ICOL1-3 )*LDA+IROW1-1 ) = ZERO
                              END IF
                           END IF
                        END IF
                     ELSE IF( M.GT.L ) THEN
                        IF( MOD( K-1, HBL ).GT.0 ) THEN
*
*                       Following differs in comparison to pdlahqr.
*
                           A( ( ICOL1-2 )*LDA+IROW1 ) = A( ( ICOL1-2 )*
     $                        LDA+IROW1 )*DCONJG( ONE-T1COPY )
                        END IF
                     END IF
                     V2 = VCOPY( 2 )
                     T2 = T1COPY*V2
                     WORK( VECSIDX+( K-1 )*3+1 ) = VCOPY( 2 )
                     WORK( VECSIDX+( K-1 )*3+2 ) = VCOPY( 3 )
                     WORK( VECSIDX+( K-1 )*3+3 ) = T1COPY
                     T1 = T1COPY
                     IF( K.LT.ISTOP ) THEN
*
*                       Do some work so next step is ready...
*
                        V3 = VCOPY( 3 )
                        T3 = T1*V3
                        DO 90 J = ( ICOL1-1 )*LDA + IROW1,
     $                          ( MIN( K2( KI )+1, I-1 )+ICOL1-K-1 )*
     $                          LDA + IROW1, LDA
                           SUM = DCONJG( T1 )*A( J ) +
     $                           DCONJG( T2 )*A( J+1 ) +
     $                           DCONJG( T3 )*A( J+2 )
                           A( J ) = A( J ) - SUM
                           A( J+1 ) = A( J+1 ) - SUM*V2
                           A( J+2 ) = A( J+2 ) - SUM*V3
   90                   CONTINUE
                        DO 100 J = IROW1 + 1, IROW1 + 3
                           SUM = T1*A( ( ICOL1-1 )*LDA+J ) +
     $                           T2*A( ICOL1*LDA+J ) +
     $                           T3*A( ( ICOL1+1 )*LDA+J )
                           A( ( ICOL1-1 )*LDA+J ) = A( ( ICOL1-1 )*LDA+
     $                        J ) - SUM
                           A( ICOL1*LDA+J ) = A( ICOL1*LDA+J ) -
     $                                        SUM*DCONJG( V2 )
                           A( ( ICOL1+1 )*LDA+J ) = A( ( ICOL1+1 )*LDA+
     $                        J ) - SUM*DCONJG( V3 )
  100                   CONTINUE
                     END IF
                     IROW1 = IROW1 + 1
                     ICOL1 = ICOL1 + 1
  110             CONTINUE
               END IF
  120       CONTINUE
*
*           First part of applying the transforms is complete.
*           Broadcasts of the Householder data is done here.
*
            DO 130 KI = 1, IBULGE
*
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
*
*              Broadcast Householder information from the block
*
               IF( ( MYROW.EQ.ICURROW( KI ) ) .AND. ( NPCOL.GT.1 ) .AND.
     $             ( ISTART.LE.ISTOP ) ) THEN
                  IF( MYCOL.NE.ICURCOL( KI ) ) THEN
                     CALL ZGEBR2D( CONTXT, 'ROW', ' ',
     $                             3*( ISTOP-ISTART+1 ), 1,
     $                             WORK( VECSIDX+( ISTART-1 )*3+1 ),
     $                             3*( ISTOP-ISTART+1 ), MYROW,
     $                             ICURCOL( KI ) )
                  ELSE
                     CALL ZGEBS2D( CONTXT, 'ROW', ' ',
     $                             3*( ISTOP-ISTART+1 ), 1,
     $                             WORK( VECSIDX+( ISTART-1 )*3+1 ),
     $                             3*( ISTOP-ISTART+1 ) )
                  END IF
               END IF
  130       CONTINUE
*
*           Now do column transforms and finish work
*
            DO 140 KI = 1, IBULGE
*
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
*
               IF( ( MYCOL.EQ.ICURCOL( KI ) ) .AND. ( NPROW.GT.1 ) .AND.
     $             ( ISTART.LE.ISTOP ) ) THEN
                  IF( MYROW.NE.ICURROW( KI ) ) THEN
                     CALL ZGEBR2D( CONTXT, 'COL', ' ',
     $                             3*( ISTOP-ISTART+1 ), 1,
     $                             WORK( VECSIDX+( ISTART-1 )*3+1 ),
     $                             3*( ISTOP-ISTART+1 ), ICURROW( KI ),
     $                             MYCOL )
                  ELSE
                     CALL ZGEBS2D( CONTXT, 'COL', ' ',
     $                             3*( ISTOP-ISTART+1 ), 1,
     $                             WORK( VECSIDX+( ISTART-1 )*3+1 ),
     $                             3*( ISTOP-ISTART+1 ) )
                  END IF
               END IF
  140       CONTINUE
*
*
*           Now do make up work to have things in block fashion
*
            DO 160 KI = 1, IBULGE
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
*
               MODKM1 = MOD( ISTART-1, HBL )
               IF( ( MYROW.EQ.ICURROW( KI ) ) .AND.
     $             ( MYCOL.EQ.ICURCOL( KI ) ) .AND.
     $             ( ( ( MODKM1.EQ.HBL-2 ) .AND. ( ISTART.EQ.I-
     $             1 ) ) .OR. ( ( MODKM1.LT.HBL-2 ) .AND. ( ISTART.LE.I-
     $             1 ) ) ) ) THEN
*
*                 (IROW1,ICOL1) is (I,J)-coordinates of H(ISTART,ISTART)
*
                  IROW1 = KROW( KI )
                  ICOL1 = KCOL( KI )
                  DO 150 K = ISTART, ISTOP
*
*              Catch up on column & border work
*
                     NR = MIN( 3, I-K+1 )
                     V2 = WORK( VECSIDX+( K-1 )*3+1 )
                     V3 = WORK( VECSIDX+( K-1 )*3+2 )
                     T1 = WORK( VECSIDX+( K-1 )*3+3 )
                     T2 = T1*V2
                     IF( K.LT.ISTOP ) THEN
*
*                 Do some work so next step is ready...
*
                        T3 = T1*V3
                        CALL ZLAREF( 'Col', A, LDA, .FALSE., Z, LDZ,
     $                               .FALSE., ICOL1, ICOL1, ISTART,
     $                               ISTOP, MIN( ISTART+1, I )-K+IROW1,
     $                               IROW1, LILOZ, LIHIZ,
     $                               WORK( VECSIDX+1 ), V2, V3, T1, T2,
     $                               T3 )
                        IROW1 = IROW1 + 1
                        ICOL1 = ICOL1 + 1
                     ELSE
                        IF( ( NR.EQ.3 ) .AND. ( MOD( K-1,
     $                      HBL ).LT.HBL-2 ) ) THEN
                           T3 = T1*V3
                           CALL ZLAREF( 'Row', A, LDA, .FALSE., Z, LDZ,
     $                                  .FALSE., IROW1, IROW1, ISTART,
     $                                  ISTOP, ICOL1, MIN( MIN( K2( KI )
     $                                  +1, I-1 ), I2 )-K+ICOL1, LILOZ,
     $                                  LIHIZ, WORK( VECSIDX+1 ), V2,
     $                                  V3, T1, T2, T3 )
                        END IF
                     END IF
  150             CONTINUE
               END IF
*
*           Send SMALLA back again.
*
               K = ISTART
               MODKM1 = MOD( K-1, HBL )
               IF( ( MODKM1.GE.HBL-2 ) .AND. ( K.LE.I-1 ) ) THEN
                  IF( ( MODKM1.EQ.HBL-2 ) .AND. ( K.LT.I-1 ) ) THEN
*
*                    Copy 6 elements from global A(K-1:K+4,K-1:K+4)
*
                     ITMP1 = ICURROW( KI )
                     ITMP2 = ICURCOL( KI )
                     CALL PZLACP3( MIN( 6, N-K+2 ), K-1, A, DESCA,
     $                             SMALLA( 1, 1, KI ), 6, ITMP1, ITMP2,
     $                             1 )
*
                  END IF
                  IF( MODKM1.EQ.HBL-1 ) THEN
*
*                    Copy 6 elements from global A(K-2:K+3,K-2:K+3)
*
                     ITMP1 = ICURROW( KI )
                     ITMP2 = ICURCOL( KI )
                     CALL PZLACP3( MIN( 6, N-K+3 ), K-2, A, DESCA,
     $                             SMALLA( 1, 1, KI ), 6, ITMP1, ITMP2,
     $                             1 )
                  END IF
               END IF
*
  160       CONTINUE
*
  170       CONTINUE
*
*           Now start major set of block ROW reflections
*
            DO 180 KI = 1, IBULGE
               IF( ( MYROW.NE.ICURROW( KI ) ) .AND.
     $             ( DOWN.NE.ICURROW( KI ) ) )GO TO 180
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
*
               IF( ( ISTOP.GT.ISTART ) .AND.
     $             ( MOD( ISTART-1, HBL ).LT.HBL-2 ) .AND.
     $             ( ICURROW( KI ).EQ.MYROW ) ) THEN
                  IROW1 = MIN( K2( KI )+1, I-1 ) + 1
                  CALL INFOG1L( IROW1, HBL, NPCOL, MYCOL, JAFIRST,
     $                          ITMP1, ITMP2 )
                  ITMP2 = LOCALI2
                  II = KROW( KI )
                  CALL ZLAREF( 'Row', A, LDA, WANTZ, Z, LDZ, .TRUE., II,
     $                         II, ISTART, ISTOP, ITMP1, ITMP2, LILOZ,
     $                         LIHIZ, WORK( VECSIDX+1 ), V2, V3, T1, T2,
     $                         T3 )
               END IF
  180       CONTINUE
*
            DO 220 KI = 1, IBULGE
               IF( KROW( KI ).GT.KP2ROW( KI ) )
     $            GO TO 220
               IF( ( MYROW.NE.ICURROW( KI ) ) .AND.
     $             ( DOWN.NE.ICURROW( KI ) ) )GO TO 220
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
               IF( ( ISTART.EQ.ISTOP ) .OR.
     $             ( MOD( ISTART-1, HBL ).GE.HBL-2 ) .OR.
     $             ( ICURROW( KI ).NE.MYROW ) ) THEN
                  DO 210 K = ISTART, ISTOP
                     V2 = WORK( VECSIDX+( K-1 )*3+1 )
                     V3 = WORK( VECSIDX+( K-1 )*3+2 )
                     T1 = WORK( VECSIDX+( K-1 )*3+3 )
                     NR = MIN( 3, I-K+1 )
                     IF( ( NR.EQ.3 ) .AND. ( KROW( KI ).LE.
     $                   KP2ROW( KI ) ) ) THEN
                        IF( ( K.LT.ISTOP ) .AND.
     $                      ( MOD( K-1, HBL ).LT.HBL-2 ) ) THEN
                           ITMP1 = MIN( K2( KI )+1, I-1 ) + 1
                        ELSE
                           IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                              ITMP1 = MIN( K2( KI )+1, I-1 ) + 1
                           END IF
                           IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                              ITMP1 = MIN( K+4, I2 ) + 1
                           END IF
                           IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                              ITMP1 = MIN( K+3, I2 ) + 1
                           END IF
                        END IF
*
*                    Find local coor of rows K through K+2
*
                        IROW1 = KROW( KI )
                        IROW2 = KP2ROW( KI )
                        IF( ( K.GT.ISTART ) .AND.
     $                      ( MOD( K-1, HBL ).GE.HBL-2 ) ) THEN
                           IF( DOWN.EQ.ICURROW( KI ) ) THEN
                              IROW1 = IROW1 + 1
                           END IF
                           IF( MYROW.EQ.ICURROW( KI ) ) THEN
                              IROW2 = IROW2 + 1
                           END IF
                        END IF
                        CALL INFOG1L( ITMP1, HBL, NPCOL, MYCOL, JAFIRST,
     $                                ICOL1, ICOL2 )
                        ICOL2 = LOCALI2
                        IF( ( MOD( K-1, HBL ).LT.HBL-2 ) .OR.
     $                      ( NPROW.EQ.1 ) ) THEN
                           T2 = T1*V2
                           T3 = T1*V3
                           CALL ZLAREF( 'Row', A, LDA, WANTZ, Z, LDZ,
     $                                  .FALSE., IROW1, IROW1, ISTART,
     $                                  ISTOP, ICOL1, ICOL2, LILOZ,
     $                                  LIHIZ, WORK( VECSIDX+1 ), V2,
     $                                  V3, T1, T2, T3 )
                        END IF
                        IF( ( MOD( K-1, HBL ).EQ.HBL-2 ) .AND.
     $                      ( NPROW.GT.1 ) ) THEN
                           IF( IROW1.NE.IROW2 ) THEN
                              CALL ZGESD2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                      A( ( ICOL1-1 )*LDA+IROW1 ),
     $                                      LDA, DOWN, MYCOL )
                              IF( SKIP .AND. ( ISTART.EQ.ISTOP ) ) THEN
                                 CALL ZGERV2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                         A( ( ICOL1-1 )*LDA+
     $                                         IROW1 ), LDA, DOWN,
     $                                         MYCOL )
                              END IF
                           ELSE IF( SKIP ) THEN
                              CALL ZGERV2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                      WORK( IRBUF+1 ), 2, UP,
     $                                      MYCOL )
                              T2 = T1*V2
                              T3 = T1*V3
                              DO 190 J = ICOL1, ICOL2
                                 SUM = DCONJG( T1 )*
     $                                 WORK( IRBUF+2*( J-ICOL1 )+1 ) +
     $                                 DCONJG( T2 )*WORK( IRBUF+2*
     $                                 ( J-ICOL1 )+2 ) +
     $                                 DCONJG( T3 )*A( ( J-1 )*LDA+
     $                                 IROW1 )
                                 WORK( IRBUF+2*( J-ICOL1 )+1 )
     $                              = WORK( IRBUF+2*( J-ICOL1 )+1 ) -
     $                              SUM
                                 WORK( IRBUF+2*( J-ICOL1 )+2 )
     $                              = WORK( IRBUF+2*( J-ICOL1 )+2 ) -
     $                              SUM*V2
                                 A( ( J-1 )*LDA+IROW1 ) = A( ( J-1 )*
     $                              LDA+IROW1 ) - SUM*V3
  190                         CONTINUE
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGESD2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                         WORK( IRBUF+1 ), 2, UP,
     $                                         MYCOL )
                              END IF
                           END IF
                        END IF
                        IF( ( MOD( K-1, HBL ).EQ.HBL-1 ) .AND.
     $                      ( NPROW.GT.1 ) ) THEN
                           IF( IROW1.EQ.IROW2 ) THEN
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGESD2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                         A( ( ICOL1-1 )*LDA+IROW1-
     $                                         1 ), LDA, DOWN, MYCOL )
                              END IF
                              IF( SKIP ) THEN
                                 CALL ZGERV2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                         A( ( ICOL1-1 )*LDA+IROW1-
     $                                         1 ), LDA, DOWN, MYCOL )
                              END IF
                           ELSE IF( SKIP ) THEN
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGERV2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                         WORK( IRBUF+1 ), 2, UP,
     $                                         MYCOL )
                              END IF
                              T2 = T1*V2
                              T3 = T1*V3
                              DO 200 J = ICOL1, ICOL2
                                 SUM = DCONJG( T1 )*
     $                                 WORK( IRBUF+2*( J-ICOL1 )+2 ) +
     $                                 DCONJG( T2 )*A( ( J-1 )*LDA+
     $                                 IROW1 ) + DCONJG( T3 )*
     $                                 A( ( J-1 )*LDA+IROW1+1 )
                                 WORK( IRBUF+2*( J-ICOL1 )+2 )
     $                              = WORK( IRBUF+2*( J-ICOL1 )+2 ) -
     $                              SUM
                                 A( ( J-1 )*LDA+IROW1 ) = A( ( J-1 )*
     $                              LDA+IROW1 ) - SUM*V2
                                 A( ( J-1 )*LDA+IROW1+1 ) = A( ( J-1 )*
     $                              LDA+IROW1+1 ) - SUM*V3
  200                         CONTINUE
                              CALL ZGESD2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                      WORK( IRBUF+1 ), 2, UP,
     $                                      MYCOL )
*
                           END IF
                        END IF
                     END IF
  210             CONTINUE
               END IF
  220       CONTINUE
*
            IF( SKIP )
     $         GO TO 290
*
            DO 260 KI = 1, IBULGE
               IF( KROW( KI ).GT.KP2ROW( KI ) )
     $            GO TO 260
               IF( ( MYROW.NE.ICURROW( KI ) ) .AND.
     $             ( DOWN.NE.ICURROW( KI ) ) )GO TO 260
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
               IF( ( ISTART.EQ.ISTOP ) .OR.
     $             ( MOD( ISTART-1, HBL ).GE.HBL-2 ) .OR.
     $             ( ICURROW( KI ).NE.MYROW ) ) THEN
                  DO 250 K = ISTART, ISTOP
                     V2 = WORK( VECSIDX+( K-1 )*3+1 )
                     V3 = WORK( VECSIDX+( K-1 )*3+2 )
                     T1 = WORK( VECSIDX+( K-1 )*3+3 )
                     NR = MIN( 3, I-K+1 )
                     IF( ( NR.EQ.3 ) .AND. ( KROW( KI ).LE.
     $                   KP2ROW( KI ) ) ) THEN
                        IF( ( K.LT.ISTOP ) .AND.
     $                      ( MOD( K-1, HBL ).LT.HBL-2 ) ) THEN
                           ITMP1 = MIN( K2( KI )+1, I-1 ) + 1
                        ELSE
                           IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                              ITMP1 = MIN( K2( KI )+1, I-1 ) + 1
                           END IF
                           IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                              ITMP1 = MIN( K+4, I2 ) + 1
                           END IF
                           IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                              ITMP1 = MIN( K+3, I2 ) + 1
                           END IF
                        END IF
*
*                    Find local coor of rows K through K+2
*
                        IROW1 = KROW( KI )
                        IROW2 = KP2ROW( KI )
                        IF( ( K.GT.ISTART ) .AND.
     $                      ( MOD( K-1, HBL ).GE.HBL-2 ) ) THEN
                           IF( DOWN.EQ.ICURROW( KI ) ) THEN
                              IROW1 = IROW1 + 1
                           END IF
                           IF( MYROW.EQ.ICURROW( KI ) ) THEN
                              IROW2 = IROW2 + 1
                           END IF
                        END IF
                        CALL INFOG1L( ITMP1, HBL, NPCOL, MYCOL, JAFIRST,
     $                                ICOL1, ICOL2 )
                        ICOL2 = LOCALI2
                        IF( ( MOD( K-1, HBL ).EQ.HBL-2 ) .AND.
     $                      ( NPROW.GT.1 ) ) THEN
                           IF( IROW1.EQ.IROW2 ) THEN
                              CALL ZGERV2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                      WORK( IRBUF+1 ), 2, UP,
     $                                      MYCOL )
                              T2 = T1*V2
                              T3 = T1*V3
                              DO 230 J = ICOL1, ICOL2
                                 SUM = DCONJG( T1 )*
     $                                 WORK( IRBUF+2*( J-ICOL1 )+1 ) +
     $                                 DCONJG( T2 )*WORK( IRBUF+2*
     $                                 ( J-ICOL1 )+2 ) +
     $                                 DCONJG( T3 )*A( ( J-1 )*LDA+
     $                                 IROW1 )
                                 WORK( IRBUF+2*( J-ICOL1 )+1 )
     $                              = WORK( IRBUF+2*( J-ICOL1 )+1 ) -
     $                              SUM
                                 WORK( IRBUF+2*( J-ICOL1 )+2 )
     $                              = WORK( IRBUF+2*( J-ICOL1 )+2 ) -
     $                              SUM*V2
                                 A( ( J-1 )*LDA+IROW1 ) = A( ( J-1 )*
     $                              LDA+IROW1 ) - SUM*V3
  230                         CONTINUE
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGESD2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                         WORK( IRBUF+1 ), 2, UP,
     $                                         MYCOL )
                              END IF
                           END IF
                        END IF
                        IF( ( MOD( K-1, HBL ).EQ.HBL-1 ) .AND.
     $                      ( NPROW.GT.1 ) ) THEN
                           IF( IROW1.NE.IROW2 ) THEN
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGERV2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                         WORK( IRBUF+1 ), 2, UP,
     $                                         MYCOL )
                              END IF
                              T2 = T1*V2
                              T3 = T1*V3
                              DO 240 J = ICOL1, ICOL2
                                 SUM = DCONJG( T1 )*
     $                                 WORK( IRBUF+2*( J-ICOL1 )+2 ) +
     $                                 DCONJG( T2 )*A( ( J-1 )*LDA+
     $                                 IROW1 ) + DCONJG( T3 )*
     $                                 A( ( J-1 )*LDA+IROW1+1 )
                                 WORK( IRBUF+2*( J-ICOL1 )+2 )
     $                              = WORK( IRBUF+2*( J-ICOL1 )+2 ) -
     $                              SUM
                                 A( ( J-1 )*LDA+IROW1 ) = A( ( J-1 )*
     $                              LDA+IROW1 ) - SUM*V2
                                 A( ( J-1 )*LDA+IROW1+1 ) = A( ( J-1 )*
     $                              LDA+IROW1+1 ) - SUM*V3
  240                         CONTINUE
                              CALL ZGESD2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                      WORK( IRBUF+1 ), 2, UP,
     $                                      MYCOL )
                           END IF
                        END IF
                     END IF
  250             CONTINUE
               END IF
  260       CONTINUE
*
            DO 280 KI = 1, IBULGE
               IF( KROW( KI ).GT.KP2ROW( KI ) )
     $            GO TO 280
               IF( ( MYROW.NE.ICURROW( KI ) ) .AND.
     $             ( DOWN.NE.ICURROW( KI ) ) )GO TO 280
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
               IF( ( ISTART.EQ.ISTOP ) .OR.
     $             ( MOD( ISTART-1, HBL ).GE.HBL-2 ) .OR.
     $             ( ICURROW( KI ).NE.MYROW ) ) THEN
                  DO 270 K = ISTART, ISTOP
                     V2 = WORK( VECSIDX+( K-1 )*3+1 )
                     V3 = WORK( VECSIDX+( K-1 )*3+2 )
                     T1 = WORK( VECSIDX+( K-1 )*3+3 )
                     NR = MIN( 3, I-K+1 )
                     IF( ( NR.EQ.3 ) .AND. ( KROW( KI ).LE.
     $                   KP2ROW( KI ) ) ) THEN
                        IF( ( K.LT.ISTOP ) .AND.
     $                      ( MOD( K-1, HBL ).LT.HBL-2 ) ) THEN
                           ITMP1 = MIN( K2( KI )+1, I-1 ) + 1
                        ELSE
                           IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                              ITMP1 = MIN( K2( KI )+1, I-1 ) + 1
                           END IF
                           IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                              ITMP1 = MIN( K+4, I2 ) + 1
                           END IF
                           IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                              ITMP1 = MIN( K+3, I2 ) + 1
                           END IF
                        END IF
*
*                    Find local coor of rows K through K+2
*
                        IROW1 = KROW( KI )
                        IROW2 = KP2ROW( KI )
                        IF( ( K.GT.ISTART ) .AND.
     $                      ( MOD( K-1, HBL ).GE.HBL-2 ) ) THEN
                           IF( DOWN.EQ.ICURROW( KI ) ) THEN
                              IROW1 = IROW1 + 1
                           END IF
                           IF( MYROW.EQ.ICURROW( KI ) ) THEN
                              IROW2 = IROW2 + 1
                           END IF
                        END IF
                        CALL INFOG1L( ITMP1, HBL, NPCOL, MYCOL, JAFIRST,
     $                                ICOL1, ICOL2 )
                        ICOL2 = LOCALI2
                        IF( ( MOD( K-1, HBL ).EQ.HBL-2 ) .AND.
     $                      ( NPROW.GT.1 ) ) THEN
                           IF( IROW1.NE.IROW2 ) THEN
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGERV2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                         A( ( ICOL1-1 )*LDA+
     $                                         IROW1 ), LDA, DOWN,
     $                                         MYCOL )
                              END IF
                           END IF
                        END IF
                        IF( ( MOD( K-1, HBL ).EQ.HBL-1 ) .AND.
     $                      ( NPROW.GT.1 ) ) THEN
                           IF( IROW1.EQ.IROW2 ) THEN
                              CALL ZGERV2D( CONTXT, 2, ICOL2-ICOL1+1,
     $                                      A( ( ICOL1-1 )*LDA+IROW1-
     $                                      1 ), LDA, DOWN, MYCOL )
                           END IF
                        END IF
                     END IF
  270             CONTINUE
               END IF
  280       CONTINUE
*
  290       CONTINUE
*
*           Now start major set of block COL reflections
*
            DO 300 KI = 1, IBULGE
               IF( ( MYCOL.NE.ICURCOL( KI ) ) .AND.
     $             ( RIGHT.NE.ICURCOL( KI ) ) )GO TO 300
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
*
               IF( ( ( MOD( ISTART-1, HBL ).LT.HBL-2 ) .OR. ( NPCOL.EQ.
     $             1 ) ) .AND. ( ICURCOL( KI ).EQ.MYCOL ) .AND.
     $             ( I-ISTOP+1.GE.3 ) ) THEN
                  K = ISTART
                  IF( ( K.LT.ISTOP ) .AND. ( MOD( K-1,
     $                HBL ).LT.HBL-2 ) ) THEN
                     ITMP1 = MIN( ISTART+1, I ) - 1
                  ELSE
                     IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                        ITMP1 = MIN( K+3, I )
                     END IF
                     IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                        ITMP1 = MAX( I1, K-1 ) - 1
                     END IF
                     IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                        ITMP1 = MAX( I1, K-2 ) - 1
                     END IF
                  END IF
*
                  ICOL1 = KCOL( KI )
                  CALL INFOG1L( I1, HBL, NPROW, MYROW, IAFIRST, IROW1,
     $                          IROW2 )
                  IROW2 = NUMROC( ITMP1, HBL, MYROW, IAFIRST, NPROW )
                  IF( IROW1.LE.IROW2 ) THEN
                     ITMP2 = IROW2
                  ELSE
                     ITMP2 = -1
                  END IF
                  CALL ZLAREF( 'Col', A, LDA, WANTZ, Z, LDZ, .TRUE.,
     $                         ICOL1, ICOL1, ISTART, ISTOP, IROW1,
     $                         IROW2, LILOZ, LIHIZ, WORK( VECSIDX+1 ),
     $                         V2, V3, T1, T2, T3 )
                  K = ISTOP
                  IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
*
*                 Do from ITMP1+1 to MIN(K+3,I)
*
                     IF( MOD( K-1, HBL ).LT.HBL-3 ) THEN
                        IROW1 = ITMP2 + 1
                        IF( MOD( ( ITMP1 / HBL ), NPROW ).EQ.MYROW )
     $                       THEN
                           IF( ITMP2.GT.0 ) THEN
                              IROW2 = ITMP2 + MIN( K+3, I ) - ITMP1
                           ELSE
                              IROW2 = IROW1 - 1
                           END IF
                        ELSE
                           IROW2 = IROW1 - 1
                        END IF
                     ELSE
                        CALL INFOG1L( ITMP1+1, HBL, NPROW, MYROW,
     $                                IAFIRST, IROW1, IROW2 )
                        IROW2 = NUMROC( MIN( K+3, I ), HBL, MYROW,
     $                          IAFIRST, NPROW )
                     END IF
                     V2 = WORK( VECSIDX+( K-1 )*3+1 )
                     V3 = WORK( VECSIDX+( K-1 )*3+2 )
                     T1 = WORK( VECSIDX+( K-1 )*3+3 )
                     T2 = T1*V2
                     T3 = T1*V3
                     ICOL1 = KCOL( KI ) + ISTOP - ISTART
                     CALL ZLAREF( 'Col', A, LDA, .FALSE., Z, LDZ,
     $                            .FALSE., ICOL1, ICOL1, ISTART, ISTOP,
     $                            IROW1, IROW2, LILOZ, LIHIZ,
     $                            WORK( VECSIDX+1 ), V2, V3, T1, T2,
     $                            T3 )
                  END IF
               END IF
  300       CONTINUE
*
            DO 360 KI = 1, IBULGE
               IF( KCOL( KI ).GT.KP2COL( KI ) )
     $            GO TO 360
               IF( ( MYCOL.NE.ICURCOL( KI ) ) .AND.
     $             ( RIGHT.NE.ICURCOL( KI ) ) )GO TO 360
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
               IF( MOD( ISTART-1, HBL ).GE.HBL-2 ) THEN
*
*              INFO is found in a buffer
*
                  ISPEC = 1
               ELSE
*
*              All INFO is local
*
                  ISPEC = 0
               END IF
               DO 350 K = ISTART, ISTOP
*
                  V2 = WORK( VECSIDX+( K-1 )*3+1 )
                  V3 = WORK( VECSIDX+( K-1 )*3+2 )
                  T1 = WORK( VECSIDX+( K-1 )*3+3 )
                  NR = MIN( 3, I-K+1 )
                  IF( ( NR.EQ.3 ) .AND. ( KCOL( KI ).LE.KP2COL( KI ) ) )
     $                 THEN
*
                     IF( ( K.LT.ISTOP ) .AND.
     $                   ( MOD( K-1, HBL ).LT.HBL-2 ) ) THEN
                        ITMP1 = MIN( ISTART+1, I ) - 1
                     ELSE
                        IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                           ITMP1 = MIN( K+3, I )
                        END IF
                        IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                           ITMP1 = MAX( I1, K-1 ) - 1
                        END IF
                        IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                           ITMP1 = MAX( I1, K-2 ) - 1
                        END IF
                     END IF
                     IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                        ICOL1 = KCOL( KI ) + K - ISTART
                        ICOL2 = KP2COL( KI ) + K - ISTART
                     ELSE
                        ICOL1 = KCOL( KI )
                        ICOL2 = KP2COL( KI )
                        IF( K.GT.ISTART ) THEN
                           IF( RIGHT.EQ.ICURCOL( KI ) ) THEN
                              ICOL1 = ICOL1 + 1
                           END IF
                           IF( MYCOL.EQ.ICURCOL( KI ) ) THEN
                              ICOL2 = ICOL2 + 1
                           END IF
                        END IF
                     END IF
                     CALL INFOG1L( I1, HBL, NPROW, MYROW, IAFIRST,
     $                             IROW1, IROW2 )
                     IROW2 = NUMROC( ITMP1, HBL, MYROW, IAFIRST, NPROW )
                     IF( ( MOD( K-1, HBL ).EQ.HBL-2 ) .AND.
     $                   ( NPCOL.GT.1 ) ) THEN
                        IF( ICOL1.NE.ICOL2 ) THEN
                           CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                   A( ( ICOL1-1 )*LDA+IROW1 ),
     $                                   LDA, MYROW, RIGHT )
                           IF( ( ISTART.EQ.ISTOP ) .AND. SKIP ) THEN
                              CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      A( ( ICOL1-1 )*LDA+IROW1 ),
     $                                      LDA, MYROW, RIGHT )
                           END IF
                        ELSE IF( SKIP ) THEN
                           T2 = T1*V2
                           T3 = T1*V3
                           CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                   WORK( ICBUF+1 ), IROW2-IROW1+1,
     $                                   MYROW, LEFT )
                           II = ICBUF - IROW1 + 1
                           JJ = ICBUF + IROW2 - 2*IROW1 + 2
                           DO 310 J = IROW1, IROW2
                              SUM = T1*WORK( II+J ) + T2*WORK( JJ+J ) +
     $                              T3*A( ( ICOL1-1 )*LDA+J )
                              WORK( II+J ) = WORK( II+J ) - SUM
                              WORK( JJ+J ) = WORK( JJ+J ) -
     $                                       SUM*DCONJG( V2 )
                              A( ( ICOL1-1 )*LDA+J ) = A( ( ICOL1-1 )*
     $                           LDA+J ) - SUM*DCONJG( V3 )
  310                      CONTINUE
                           IF( ISTART.EQ.ISTOP ) THEN
                              CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      WORK( ICBUF+1 ),
     $                                      IROW2-IROW1+1, MYROW, LEFT )
                           END IF
                        END IF
                     END IF
                     IF( ( MOD( K-1, HBL ).EQ.HBL-1 ) .AND.
     $                   ( NPCOL.GT.1 ) ) THEN
                        IF( ICOL1.EQ.ICOL2 ) THEN
                           IF( ISTART.EQ.ISTOP ) THEN
                              CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      A( ( ICOL1-2 )*LDA+IROW1 ),
     $                                      LDA, MYROW, RIGHT )
                           END IF
                           IF( SKIP ) THEN
                              CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      A( ( ICOL1-2 )*LDA+IROW1 ),
     $                                      LDA, MYROW, RIGHT )
                           END IF
                        ELSE IF( SKIP ) THEN
                           IF( ISTART.EQ.ISTOP ) THEN
                              CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      WORK( ICBUF+1 ),
     $                                      IROW2-IROW1+1, MYROW, LEFT )
                           END IF
                           T2 = T1*V2
                           T3 = T1*V3
                           II = ICBUF + IROW2 - 2*IROW1 + 2
                           DO 320 J = IROW1, IROW2
                              SUM = T1*WORK( J+II ) +
     $                              T2*A( ( ICOL1-1 )*LDA+J ) +
     $                              T3*A( ICOL1*LDA+J )
                              WORK( J+II ) = WORK( J+II ) - SUM
                              A( ( ICOL1-1 )*LDA+J ) = A( ( ICOL1-1 )*
     $                           LDA+J ) - SUM*DCONJG( V2 )
                              A( ICOL1*LDA+J ) = A( ICOL1*LDA+J ) -
     $                                           SUM*DCONJG( V3 )
  320                      CONTINUE
                           CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                   WORK( ICBUF+1 ), IROW2-IROW1+1,
     $                                   MYROW, LEFT )
                        END IF
                     END IF
*
*                    If we want Z and we haven't already done any Z
*
                     IF( ( WANTZ ) .AND. ( MOD( K-1,
     $                   HBL ).GE.HBL-2 ) .AND. ( NPCOL.GT.1 ) ) THEN
*
*                       Accumulate transformations in the matrix Z
*
                        IROW1 = LILOZ
                        IROW2 = LIHIZ
                        IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                           IF( ICOL1.NE.ICOL2 ) THEN
                              CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      Z( ( ICOL1-1 )*LDZ+IROW1 ),
     $                                      LDZ, MYROW, RIGHT )
                              IF( ( ISTART.EQ.ISTOP ) .AND. SKIP ) THEN
                                 CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                         Z( ( ICOL1-1 )*LDZ+
     $                                         IROW1 ), LDZ, MYROW,
     $                                         RIGHT )
                              END IF
                           ELSE IF( SKIP ) THEN
                              CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      WORK( IZBUF+1 ),
     $                                      IROW2-IROW1+1, MYROW, LEFT )
                              T2 = T1*V2
                              T3 = T1*V3
                              ICOL1 = ( ICOL1-1 )*LDZ
                              II = IZBUF - IROW1 + 1
                              JJ = IZBUF + IROW2 - 2*IROW1 + 2
                              DO 330 J = IROW1, IROW2
                                 SUM = T1*WORK( II+J ) +
     $                                 T2*WORK( JJ+J ) + T3*Z( ICOL1+J )
                                 WORK( II+J ) = WORK( II+J ) - SUM
                                 WORK( JJ+J ) = WORK( JJ+J ) -
     $                                          SUM*DCONJG( V2 )
                                 Z( ICOL1+J ) = Z( ICOL1+J ) -
     $                                          SUM*DCONJG( V3 )
  330                         CONTINUE
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                         WORK( IZBUF+1 ),
     $                                         IROW2-IROW1+1, MYROW,
     $                                         LEFT )
                              END IF
                           END IF
                        END IF
                        IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                           IF( ICOL1.EQ.ICOL2 ) THEN
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                         Z( ( ICOL1-2 )*LDZ+
     $                                         IROW1 ), LDZ, MYROW,
     $                                         RIGHT )
                              END IF
                              IF( SKIP ) THEN
                                 CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                         Z( ( ICOL1-2 )*LDZ+
     $                                         IROW1 ), LDZ, MYROW,
     $                                         RIGHT )
                              END IF
                           ELSE IF( SKIP ) THEN
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                         WORK( IZBUF+1 ),
     $                                         IROW2-IROW1+1, MYROW,
     $                                         LEFT )
                              END IF
                              T2 = T1*V2
                              T3 = T1*V3
                              ICOL1 = ( ICOL1-1 )*LDZ
                              II = IZBUF + IROW2 - 2*IROW1 + 2
                              DO 340 J = IROW1, IROW2
                                 SUM = T1*WORK( II+J ) +
     $                                 T2*Z( J+ICOL1 ) +
     $                                 T3*Z( J+ICOL1+LDZ )
                                 WORK( II+J ) = WORK( II+J ) - SUM
                                 Z( J+ICOL1 ) = Z( J+ICOL1 ) -
     $                                          SUM*DCONJG( V2 )
                                 Z( J+ICOL1+LDZ ) = Z( J+ICOL1+LDZ ) -
     $                                              SUM*DCONJG( V3 )
  340                         CONTINUE
                              CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      WORK( IZBUF+1 ),
     $                                      IROW2-IROW1+1, MYROW, LEFT )
                           END IF
                        END IF
                     END IF
                  END IF
  350          CONTINUE
  360       CONTINUE
*
            IF( SKIP )
     $         GO TO 450
*
            DO 420 KI = 1, IBULGE
               IF( KCOL( KI ).GT.KP2COL( KI ) )
     $            GO TO 420
               IF( ( MYCOL.NE.ICURCOL( KI ) ) .AND.
     $             ( RIGHT.NE.ICURCOL( KI ) ) )GO TO 420
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
               IF( MOD( ISTART-1, HBL ).GE.HBL-2 ) THEN
*
*                 INFO is found in a buffer
*
                  ISPEC = 1
               ELSE
*
*                 All INFO is local
*
                  ISPEC = 0
               END IF
               DO 410 K = ISTART, ISTOP
*
                  V2 = WORK( VECSIDX+( K-1 )*3+1 )
                  V3 = WORK( VECSIDX+( K-1 )*3+2 )
                  T1 = WORK( VECSIDX+( K-1 )*3+3 )
                  NR = MIN( 3, I-K+1 )
                  IF( ( NR.EQ.3 ) .AND. ( KCOL( KI ).LE.KP2COL( KI ) ) )
     $                 THEN
*
                     IF( ( K.LT.ISTOP ) .AND.
     $                   ( MOD( K-1, HBL ).LT.HBL-2 ) ) THEN
                        ITMP1 = MIN( ISTART+1, I ) - 1
                     ELSE
                        IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                           ITMP1 = MIN( K+3, I )
                        END IF
                        IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                           ITMP1 = MAX( I1, K-1 ) - 1
                        END IF
                        IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                           ITMP1 = MAX( I1, K-2 ) - 1
                        END IF
                     END IF
                     IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                        ICOL1 = KCOL( KI ) + K - ISTART
                        ICOL2 = KP2COL( KI ) + K - ISTART
                     ELSE
                        ICOL1 = KCOL( KI )
                        ICOL2 = KP2COL( KI )
                        IF( K.GT.ISTART ) THEN
                           IF( RIGHT.EQ.ICURCOL( KI ) ) THEN
                              ICOL1 = ICOL1 + 1
                           END IF
                           IF( MYCOL.EQ.ICURCOL( KI ) ) THEN
                              ICOL2 = ICOL2 + 1
                           END IF
                        END IF
                     END IF
                     CALL INFOG1L( I1, HBL, NPROW, MYROW, IAFIRST,
     $                             IROW1, IROW2 )
                     IROW2 = NUMROC( ITMP1, HBL, MYROW, IAFIRST, NPROW )
                     IF( ( MOD( K-1, HBL ).EQ.HBL-2 ) .AND.
     $                   ( NPCOL.GT.1 ) ) THEN
                        IF( ICOL1.EQ.ICOL2 ) THEN
                           CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                   WORK( ICBUF+1 ), IROW2-IROW1+1,
     $                                   MYROW, LEFT )
                           T2 = T1*V2
                           T3 = T1*V3
                           II = ICBUF - IROW1 + 1
                           JJ = ICBUF + IROW2 - 2*IROW1 + 2
                           DO 370 J = IROW1, IROW2
                              SUM = T1*WORK( II+J ) + T2*WORK( JJ+J ) +
     $                              T3*A( ( ICOL1-1 )*LDA+J )
                              WORK( II+J ) = WORK( II+J ) - SUM
                              WORK( JJ+J ) = WORK( JJ+J ) -
     $                                       SUM*DCONJG( V2 )
                              A( ( ICOL1-1 )*LDA+J ) = A( ( ICOL1-1 )*
     $                           LDA+J ) - SUM*DCONJG( V3 )
  370                      CONTINUE
                           IF( ISTART.EQ.ISTOP ) THEN
                              CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      WORK( ICBUF+1 ),
     $                                      IROW2-IROW1+1, MYROW, LEFT )
                           END IF
                        END IF
                     END IF
                     IF( ( MOD( K-1, HBL ).EQ.HBL-1 ) .AND.
     $                   ( NPCOL.GT.1 ) ) THEN
                        IF( ICOL1.NE.ICOL2 ) THEN
                           IF( ISTART.EQ.ISTOP ) THEN
                              CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      WORK( ICBUF+1 ),
     $                                      IROW2-IROW1+1, MYROW, LEFT )
                           END IF
                           T2 = T1*V2
                           T3 = T1*V3
                           II = ICBUF + IROW2 - 2*IROW1 + 2
                           DO 380 J = IROW1, IROW2
                              SUM = T1*WORK( J+II ) +
     $                              T2*A( ( ICOL1-1 )*LDA+J ) +
     $                              T3*A( ICOL1*LDA+J )
                              WORK( J+II ) = WORK( J+II ) - SUM
                              A( ( ICOL1-1 )*LDA+J ) = A( ( ICOL1-1 )*
     $                           LDA+J ) - SUM*DCONJG( V2 )
                              A( ICOL1*LDA+J ) = A( ICOL1*LDA+J ) -
     $                                           SUM*DCONJG( V3 )
  380                      CONTINUE
                           CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                   WORK( ICBUF+1 ), IROW2-IROW1+1,
     $                                   MYROW, LEFT )
                        END IF
                     END IF
*
*
*                 If we want Z and we haven't already done any Z
                     IF( ( WANTZ ) .AND. ( MOD( K-1,
     $                   HBL ).GE.HBL-2 ) .AND. ( NPCOL.GT.1 ) ) THEN
*
*                    Accumulate transformations in the matrix Z
*
                        IROW1 = LILOZ
                        IROW2 = LIHIZ
                        IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                           IF( ICOL1.EQ.ICOL2 ) THEN
                              CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      WORK( IZBUF+1 ),
     $                                      IROW2-IROW1+1, MYROW, LEFT )
                              T2 = T1*V2
                              T3 = T1*V3
                              ICOL1 = ( ICOL1-1 )*LDZ
                              II = IZBUF - IROW1 + 1
                              JJ = IZBUF + IROW2 - 2*IROW1 + 2
                              DO 390 J = IROW1, IROW2
                                 SUM = T1*WORK( II+J ) +
     $                                 T2*WORK( JJ+J ) + T3*Z( ICOL1+J )
                                 WORK( II+J ) = WORK( II+J ) - SUM
                                 WORK( JJ+J ) = WORK( JJ+J ) -
     $                                          SUM*DCONJG( V2 )
                                 Z( ICOL1+J ) = Z( ICOL1+J ) -
     $                                          SUM*DCONJG( V3 )
  390                         CONTINUE
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                         WORK( IZBUF+1 ),
     $                                         IROW2-IROW1+1, MYROW,
     $                                         LEFT )
                              END IF
                           END IF
                        END IF
                        IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                           IF( ICOL1.NE.ICOL2 ) THEN
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                         WORK( IZBUF+1 ),
     $                                         IROW2-IROW1+1, MYROW,
     $                                         LEFT )
                              END IF
                              T2 = T1*V2
                              T3 = T1*V3
                              ICOL1 = ( ICOL1-1 )*LDZ
                              II = IZBUF + IROW2 - 2*IROW1 + 2
                              DO 400 J = IROW1, IROW2
                                 SUM = T1*WORK( II+J ) +
     $                                 T2*Z( J+ICOL1 ) +
     $                                 T3*Z( J+ICOL1+LDZ )
                                 WORK( II+J ) = WORK( II+J ) - SUM
                                 Z( J+ICOL1 ) = Z( J+ICOL1 ) -
     $                                          SUM*DCONJG( V2 )
                                 Z( J+ICOL1+LDZ ) = Z( J+ICOL1+LDZ ) -
     $                                              SUM*DCONJG( V3 )
  400                         CONTINUE
                              CALL ZGESD2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      WORK( IZBUF+1 ),
     $                                      IROW2-IROW1+1, MYROW, LEFT )
                           END IF
                        END IF
                     END IF
                  END IF
  410          CONTINUE
  420       CONTINUE
*
            DO 440 KI = 1, IBULGE
               IF( KCOL( KI ).GT.KP2COL( KI ) )
     $            GO TO 440
               IF( ( MYCOL.NE.ICURCOL( KI ) ) .AND.
     $             ( RIGHT.NE.ICURCOL( KI ) ) )GO TO 440
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
               IF( MOD( ISTART-1, HBL ).GE.HBL-2 ) THEN
*
*              INFO is found in a buffer
*
                  ISPEC = 1
               ELSE
*
*              All INFO is local
*
                  ISPEC = 0
               END IF
               DO 430 K = ISTART, ISTOP
*
                  V2 = WORK( VECSIDX+( K-1 )*3+1 )
                  V3 = WORK( VECSIDX+( K-1 )*3+2 )
                  T1 = WORK( VECSIDX+( K-1 )*3+3 )
                  NR = MIN( 3, I-K+1 )
                  IF( ( NR.EQ.3 ) .AND. ( KCOL( KI ).LE.KP2COL( KI ) ) )
     $                 THEN
*
                     IF( ( K.LT.ISTOP ) .AND.
     $                   ( MOD( K-1, HBL ).LT.HBL-2 ) ) THEN
                        ITMP1 = MIN( ISTART+1, I ) - 1
                     ELSE
                        IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                           ITMP1 = MIN( K+3, I )
                        END IF
                        IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                           ITMP1 = MAX( I1, K-1 ) - 1
                        END IF
                        IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                           ITMP1 = MAX( I1, K-2 ) - 1
                        END IF
                     END IF
                     IF( MOD( K-1, HBL ).LT.HBL-2 ) THEN
                        ICOL1 = KCOL( KI ) + K - ISTART
                        ICOL2 = KP2COL( KI ) + K - ISTART
                     ELSE
                        ICOL1 = KCOL( KI )
                        ICOL2 = KP2COL( KI )
                        IF( K.GT.ISTART ) THEN
                           IF( RIGHT.EQ.ICURCOL( KI ) ) THEN
                              ICOL1 = ICOL1 + 1
                           END IF
                           IF( MYCOL.EQ.ICURCOL( KI ) ) THEN
                              ICOL2 = ICOL2 + 1
                           END IF
                        END IF
                     END IF
                     CALL INFOG1L( I1, HBL, NPROW, MYROW, IAFIRST,
     $                             IROW1, IROW2 )
                     IROW2 = NUMROC( ITMP1, HBL, MYROW, IAFIRST, NPROW )
                     IF( ( MOD( K-1, HBL ).EQ.HBL-2 ) .AND.
     $                   ( NPCOL.GT.1 ) ) THEN
                        IF( ICOL1.NE.ICOL2 ) THEN
                           IF( ISTART.EQ.ISTOP ) THEN
                              CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      A( ( ICOL1-1 )*LDA+IROW1 ),
     $                                      LDA, MYROW, RIGHT )
                           END IF
                        END IF
                     END IF
                     IF( ( MOD( K-1, HBL ).EQ.HBL-1 ) .AND.
     $                   ( NPCOL.GT.1 ) ) THEN
                        IF( ICOL1.EQ.ICOL2 ) THEN
                           CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                   A( ( ICOL1-2 )*LDA+IROW1 ),
     $                                   LDA, MYROW, RIGHT )
                        END IF
                     END IF
*
*                    If we want Z and we haven't already done any Z
*
                     IF( ( WANTZ ) .AND. ( MOD( K-1,
     $                   HBL ).GE.HBL-2 ) .AND. ( NPCOL.GT.1 ) ) THEN
*
*                       Accumulate transformations in the matrix Z
*
                        IROW1 = LILOZ
                        IROW2 = LIHIZ
                        IF( MOD( K-1, HBL ).EQ.HBL-2 ) THEN
                           IF( ICOL1.NE.ICOL2 ) THEN
                              IF( ISTART.EQ.ISTOP ) THEN
                                 CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                         Z( ( ICOL1-1 )*LDZ+
     $                                         IROW1 ), LDZ, MYROW,
     $                                         RIGHT )
                              END IF
                           END IF
                        END IF
                        IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                           IF( ICOL1.EQ.ICOL2 ) THEN
                              CALL ZGERV2D( CONTXT, IROW2-IROW1+1, 2,
     $                                      Z( ( ICOL1-2 )*LDZ+IROW1 ),
     $                                      LDZ, MYROW, RIGHT )
                           END IF
                        END IF
                     END IF
                  END IF
  430          CONTINUE
  440       CONTINUE
*
*           Column work done
*
  450       CONTINUE
*
*           Now do NR=2 work
*
            DO 530 KI = 1, IBULGE
               ISTART = MAX( K1( KI ), M )
               ISTOP = MIN( K2( KI ), I-1 )
               IF( MOD( ISTART-1, HBL ).GE.HBL-2 ) THEN
*
*                 INFO is found in a buffer
*
                  ISPEC = 1
               ELSE
*
*                 All INFO is local
*
                  ISPEC = 0
               END IF
*
               DO 520 K = ISTART, ISTOP
*
                  V2 = WORK( VECSIDX+( K-1 )*3+1 )
                  V3 = WORK( VECSIDX+( K-1 )*3+2 )
                  T1 = WORK( VECSIDX+( K-1 )*3+3 )
                  NR = MIN( 3, I-K+1 )
                  IF( NR.EQ.2 ) THEN
                     IF ( ICURROW( KI ).EQ.MYROW ) THEN
                        T2 = T1*V2
                     END IF
                     IF ( ICURCOL( KI ).EQ.MYCOL ) THEN
                        T2 = T1*V2
                     END IF
*
*              Apply G from the left to transform the rows of the matrix
*              in columns K to I2.
*
                     CALL INFOG1L( K, HBL, NPCOL, MYCOL, JAFIRST, LILOH,
     $                             LIHIH )
                     LIHIH = LOCALI2
                     CALL INFOG1L( 1, HBL, NPROW, MYROW, IAFIRST, ITMP2,
     $                             ITMP1 )
                     ITMP1 = NUMROC( K+1, HBL, MYROW, IAFIRST, NPROW )
                     IF( ICURROW( KI ).EQ.MYROW ) THEN
                        IF( ( ISPEC.EQ.0 ) .OR. ( NPROW.EQ.1 ) .OR.
     $                      ( MOD( K-1, HBL ).EQ.HBL-2 ) ) THEN
                           ITMP1 = ITMP1 - 1
                           DO 460 J = ( LILOH-1 )*LDA,
     $                             ( LIHIH-1 )*LDA, LDA
                              SUM = DCONJG( T1 )*A( ITMP1+J ) +
     $                              DCONJG( T2 )*A( ITMP1+1+J )
                              A( ITMP1+J ) = A( ITMP1+J ) - SUM
                              A( ITMP1+1+J ) = A( ITMP1+1+J ) - SUM*V2
  460                      CONTINUE
                        ELSE
                           IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                              CALL ZGERV2D( CONTXT, 1, LIHIH-LILOH+1,
     $                                      WORK( IRBUF+1 ), 1, UP,
     $                                      MYCOL )
                              DO 470 J = LILOH, LIHIH
                                 SUM = DCONJG( T1 )*
     $                                 WORK( IRBUF+J-LILOH+1 ) +
     $                                 DCONJG( T2 )*A( ( J-1 )*LDA+
     $                                 ITMP1 )
                                 WORK( IRBUF+J-LILOH+1 ) = WORK( IRBUF+
     $                              J-LILOH+1 ) - SUM
                                 A( ( J-1 )*LDA+ITMP1 ) = A( ( J-1 )*
     $                              LDA+ITMP1 ) - SUM*V2
  470                         CONTINUE
                              CALL ZGESD2D( CONTXT, 1, LIHIH-LILOH+1,
     $                                      WORK( IRBUF+1 ), 1, UP,
     $                                      MYCOL )
                           END IF
                        END IF
                     ELSE
                        IF( ( MOD( K-1, HBL ).EQ.HBL-1 ) .AND.
     $                      ( ICURROW( KI ).EQ.DOWN ) ) THEN
                           CALL ZGESD2D( CONTXT, 1, LIHIH-LILOH+1,
     $                                   A( ( LILOH-1 )*LDA+ITMP1 ),
     $                                   LDA, DOWN, MYCOL )
                           CALL ZGERV2D( CONTXT, 1, LIHIH-LILOH+1,
     $                                   A( ( LILOH-1 )*LDA+ITMP1 ),
     $                                   LDA, DOWN, MYCOL )
                        END IF
                     END IF
*
*              Apply G from the right to transform the columns of the
*              matrix in rows I1 to MIN(K+3,I).
*
                     CALL INFOG1L( I1, HBL, NPROW, MYROW, IAFIRST,
     $                             LILOH, LIHIH )
                     LIHIH = NUMROC( I, HBL, MYROW, IAFIRST, NPROW )
*
                     IF( ICURCOL( KI ).EQ.MYCOL ) THEN
*                       LOCAL A(LILOZ:LIHIZ,KCOL:KCOL+2)
                        IF( ( ISPEC.EQ.0 ) .OR. ( NPCOL.EQ.1 ) .OR.
     $                      ( MOD( K-1, HBL ).EQ.HBL-2 ) ) THEN
                           CALL INFOG1L( K, HBL, NPCOL, MYCOL, JAFIRST,
     $                                   ITMP1, ITMP2 )
                           ITMP2 = NUMROC( K+1, HBL, MYCOL, JAFIRST,
     $                             NPCOL )
                           DO 480 J = LILOH, LIHIH
                              SUM = T1*A( ( ITMP1-1 )*LDA+J ) +
     $                              T2*A( ITMP1*LDA+J )
                              A( ( ITMP1-1 )*LDA+J ) = A( ( ITMP1-1 )*
     $                           LDA+J ) - SUM
                              A( ITMP1*LDA+J ) = A( ITMP1*LDA+J ) -
     $                                           SUM*DCONJG( V2 )
  480                      CONTINUE
                        ELSE
                           ITMP1 = KCOL( KI )
                           IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                              CALL ZGERV2D( CONTXT, LIHIH-LILOH+1, 1,
     $                                      WORK( ICBUF+1 ),
     $                                      LIHIH-LILOH+1, MYROW, LEFT )
                              DO 490 J = LILOH, LIHIH
                                 SUM = T1*WORK( ICBUF+J ) +
     $                                 T2*A( ( ITMP1-1 )*LDA+J )
                                 WORK( ICBUF+J ) = WORK( ICBUF+J ) - SUM
                                 A( ( ITMP1-1 )*LDA+J )
     $                              = A( ( ITMP1-1 )*LDA+J ) -
     $                              SUM*DCONJG( V2 )
  490                         CONTINUE
                              CALL ZGESD2D( CONTXT, LIHIH-LILOH+1, 1,
     $                                      WORK( ICBUF+1 ),
     $                                      LIHIH-LILOH+1, MYROW, LEFT )
                           END IF
                        END IF
                     ELSE
                        IF( ( MOD( K-1, HBL ).EQ.HBL-1 ) .AND.
     $                      ( ICURCOL( KI ).EQ.RIGHT ) ) THEN
                           ITMP1 = KCOL( KI )
                           CALL ZGESD2D( CONTXT, LIHIH-LILOH+1, 1,
     $                                   A( ( ITMP1-1 )*LDA+LILOH ),
     $                                   LDA, MYROW, RIGHT )
                           CALL INFOG1L( K, HBL, NPCOL, MYCOL, JAFIRST,
     $                                   ITMP1, ITMP2 )
                           ITMP2 = NUMROC( K+1, HBL, MYCOL, JAFIRST,
     $                             NPCOL )
                           CALL ZGERV2D( CONTXT, LIHIH-LILOH+1, 1,
     $                                   A( ( ITMP1-1 )*LDA+LILOH ),
     $                                   LDA, MYROW, RIGHT )
                        END IF
                     END IF
*
                     IF( WANTZ ) THEN
*
*                       Accumulate transformations in the matrix Z
*
                        IF( ICURCOL( KI ).EQ.MYCOL ) THEN
*                          LOCAL Z(LILOZ:LIHIZ,KCOL:KCOL+2)
                           IF( ( ISPEC.EQ.0 ) .OR. ( NPCOL.EQ.1 ) .OR.
     $                         ( MOD( K-1, HBL ).EQ.HBL-2 ) ) THEN
                              ITMP1 = KCOL( KI ) + K - ISTART
                              ITMP1 = ( ITMP1-1 )*LDZ
                              DO 500 J = LILOZ, LIHIZ
                                 SUM = T1*Z( J+ITMP1 ) +
     $                                 T2*Z( J+ITMP1+LDZ )
                                 Z( J+ITMP1 ) = Z( J+ITMP1 ) - SUM
                                 Z( J+ITMP1+LDZ ) = Z( J+ITMP1+LDZ ) -
     $                                              SUM*DCONJG( V2 )
  500                         CONTINUE
                           ELSE
                              ITMP1 = KCOL( KI )
*                             IF WE ACTUALLY OWN COLUMN K
                              IF( MOD( K-1, HBL ).EQ.HBL-1 ) THEN
                                 CALL ZGERV2D( CONTXT, LIHIZ-LILOZ+1, 1,
     $                                         WORK( IZBUF+1 ), LDZ,
     $                                         MYROW, LEFT )
                                 ITMP1 = ( ITMP1-1 )*LDZ
                                 DO 510 J = LILOZ, LIHIZ
                                    SUM = T1*WORK( IZBUF+J ) +
     $                                    T2*Z( J+ITMP1 )
                                    WORK( IZBUF+J ) = WORK( IZBUF+J ) -
     $                                 SUM
                                    Z( J+ITMP1 ) = Z( J+ITMP1 ) -
     $                                             SUM*DCONJG( V2 )
  510                            CONTINUE
                                 CALL ZGESD2D( CONTXT, LIHIZ-LILOZ+1, 1,
     $                                         WORK( IZBUF+1 ), LDZ,
     $                                         MYROW, LEFT )
                              END IF
                           END IF
                        ELSE
*
*                          NO WORK BUT NEED TO UPDATE ANYWAY????
*
                           IF( ( MOD( K-1, HBL ).EQ.HBL-1 ) .AND.
     $                         ( ICURCOL( KI ).EQ.RIGHT ) ) THEN
                              ITMP1 = KCOL( KI )
                              ITMP1 = ( ITMP1-1 )*LDZ
                              CALL ZGESD2D( CONTXT, LIHIZ-LILOZ+1, 1,
     $                                      Z( LILOZ+ITMP1 ), LDZ,
     $                                      MYROW, RIGHT )
                              CALL ZGERV2D( CONTXT, LIHIZ-LILOZ+1, 1,
     $                                      Z( LILOZ+ITMP1 ), LDZ,
     $                                      MYROW, RIGHT )
                           END IF
                        END IF
                     END IF
                  END IF
  520          CONTINUE
*
*        Adjust local information for this bulge
*
               IF( NPROW.EQ.1 ) THEN
                  KROW( KI ) = KROW( KI ) + K2( KI ) - K1( KI ) + 1
                  KP2ROW( KI ) = KP2ROW( KI ) + K2( KI ) - K1( KI ) + 1
               END IF
               IF( ( MOD( K1( KI )-1, HBL ).LT.HBL-2 ) .AND.
     $             ( ICURROW( KI ).EQ.MYROW ) .AND. ( NPROW.GT.1 ) )
     $              THEN
                  KROW( KI ) = KROW( KI ) + K2( KI ) - K1( KI ) + 1
               END IF
               IF( ( MOD( K2( KI ), HBL ).LT.HBL-2 ) .AND.
     $             ( ICURROW( KI ).EQ.MYROW ) .AND. ( NPROW.GT.1 ) )
     $              THEN
                  KP2ROW( KI ) = KP2ROW( KI ) + K2( KI ) - K1( KI ) + 1
               END IF
               IF( ( MOD( K1( KI )-1, HBL ).GE.HBL-2 ) .AND.
     $             ( ( MYROW.EQ.ICURROW( KI ) ) .OR. ( DOWN.EQ.
     $             ICURROW( KI ) ) ) .AND. ( NPROW.GT.1 ) ) THEN
                  CALL INFOG1L( K2( KI )+1, HBL, NPROW, MYROW, IAFIRST,
     $                          KROW( KI ), ITMP2 )
               END IF
               IF( ( MOD( K2( KI ), HBL ).GE.HBL-2 ) .AND.
     $             ( ( MYROW.EQ.ICURROW( KI ) ) .OR. ( UP.EQ.
     $             ICURROW( KI ) ) ) .AND. ( NPROW.GT.1 ) ) THEN
                  KP2ROW( KI ) = NUMROC( K2( KI )+3, HBL, MYROW,
     $                           IAFIRST, NPROW )
               END IF
               IF( NPCOL.EQ.1 ) THEN
                  KCOL( KI ) = KCOL( KI ) + K2( KI ) - K1( KI ) + 1
                  KP2COL( KI ) = KP2COL( KI ) + K2( KI ) - K1( KI ) + 1
               END IF
               IF( ( MOD( K1( KI )-1, HBL ).LT.HBL-2 ) .AND.
     $             ( ICURCOL( KI ).EQ.MYCOL ) .AND. ( NPCOL.GT.1 ) )
     $              THEN
                  KCOL( KI ) = KCOL( KI ) + K2( KI ) - K1( KI ) + 1
               END IF
               IF( ( MOD( K2( KI ), HBL ).LT.HBL-2 ) .AND.
     $             ( ICURCOL( KI ).EQ.MYCOL ) .AND. ( NPCOL.GT.1 ) )
     $              THEN
                  KP2COL( KI ) = KP2COL( KI ) + K2( KI ) - K1( KI ) + 1
               END IF
               IF( ( MOD( K1( KI )-1, HBL ).GE.HBL-2 ) .AND.
     $             ( ( MYCOL.EQ.ICURCOL( KI ) ) .OR. ( RIGHT.EQ.
     $             ICURCOL( KI ) ) ) .AND. ( NPCOL.GT.1 ) ) THEN
                  CALL INFOG1L( K2( KI )+1, HBL, NPCOL, MYCOL, JAFIRST,
     $                          KCOL( KI ), ITMP2 )
               END IF
               IF( ( MOD( K2( KI ), HBL ).GE.HBL-2 ) .AND.
     $             ( ( MYCOL.EQ.ICURCOL( KI ) ) .OR. ( LEFT.EQ.
     $             ICURCOL( KI ) ) ) .AND. ( NPCOL.GT.1 ) ) THEN
                  KP2COL( KI ) = NUMROC( K2( KI )+3, HBL, MYCOL,
     $                           JAFIRST, NPCOL )
               END IF
               K1( KI ) = K2( KI ) + 1
               ISTOP = MIN( K1( KI )+ROTN-MOD( K1( KI ), ROTN ), I-2 )
               ISTOP = MIN( ISTOP, K1( KI )+HBL-3-
     $                 MOD( K1( KI )-1, HBL ) )
               ISTOP = MIN( ISTOP, I2-2 )
               ISTOP = MAX( ISTOP, K1( KI ) )
               IF( ( MOD( K1( KI )-1, HBL ).EQ.HBL-2 ) .AND.
     $             ( ISTOP.LT.MIN( I-2, I2-2 ) ) ) THEN
                  ISTOP = ISTOP + 1
               END IF
               K2( KI ) = ISTOP
               IF( K1( KI ).LE.ISTOP ) THEN
                  IF( ( MOD( K1( KI )-1, HBL ).EQ.HBL-2 ) .AND.
     $                ( I-K1( KI ).GT.1 ) ) THEN
*
*                    Next step switches rows & cols
*
                     ICURROW( KI ) = MOD( ICURROW( KI )+1, NPROW )
                     ICURCOL( KI ) = MOD( ICURCOL( KI )+1, NPCOL )
                  END IF
               END IF
  530       CONTINUE
*
            IF( K2( IBULGE ).LE.I-1 )
     $         GO TO 40
         END IF
*
  540 CONTINUE
*
*     Failure to converge in remaining number of iterations
*
      INFO = I
      RETURN
*
  550 CONTINUE
*
      IF( L.EQ.I ) THEN
*
*        H(I,I-1) is negligible: one eigenvalue has converged.
*
         CALL INFOG2L( I, I, DESCA, NPROW, NPCOL, MYROW, MYCOL, IROW,
     $                 ICOL, ITMP1, ITMP2 )
         IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN
            W( I ) = A( ( ICOL-1 )*LDA+IROW )
         ELSE
            W( I ) = ZERO
         END IF
      ELSE IF( L.EQ.I-1 ) THEN
*
*        H(I-1,I-2) is negligible: a pair of eigenvalues have converged.
*
         CALL PZLACP3( 2, I-1, A, DESCA, S1, 2*IBLK, -1, -1, 0 )
         CALL ZLANV2( S1( 1, 1 ), S1( 1, 2 ), S1( 2, 1 ), S1( 2, 2 ),
     $                W( I-1 ), W( I ), CS, SN )
         CALL PZLACP3( 2, I-1, A, DESCA, S1, 2*IBLK, 0, 0, 1 )
*
         IF( NODE.NE.0 ) THEN
*           Erase the eigenvalues other eigenvalues
            W( I-1 ) = ZERO
            W( I ) = ZERO
         END IF
*
         IF( WANTT ) THEN
*
*           Apply the transformation to A.
*
            IF( I2.GT.I ) THEN
               CALL PZROT( I2-I, A, I-1, I+1, DESCA, N, A, I, I+1,
     $                     DESCA, N, CS, SN )
            END IF
            CALL PZROT( I-I1-1, A, I1, I-1, DESCA, 1, A, I1, I, DESCA,
     $                  1, CS, DCONJG( SN ) )
         END IF
         IF( WANTZ ) THEN
*
*           Apply the transformation to Z.
*
            CALL PZROT( NZ, Z, ILOZ, I-1, DESCZ, 1, Z, ILOZ, I, DESCZ,
     $                  1, CS, DCONJG( SN ) )
         END IF
*
      ELSE
*
*        Find the eigenvalues in H(L:I,L:I), L < I-1
*
         JBLK = I - L + 1
         IF( JBLK.LE.2*IBLK ) THEN
            CALL PZLACP3( I-L+1, L, A, DESCA, S1, 2*IBLK, 0, 0, 0 )
            CALL ZLAHQR2( .FALSE., .FALSE., JBLK, 1, JBLK, S1, 2*IBLK,
     $                   W( L ), 1, JBLK, Z, LDZ, IERR )
            IF( NODE.NE.0 ) THEN
*
*              Erase the eigenvalues
*
               DO 560 K = L, I
                  W( K ) = ZERO
  560          CONTINUE
            END IF
         END IF
      END IF
*
*     Decrement number of remaining iterations, and return to start of
*     the main loop with new value of I.
*
      ITN = ITN - ITS
      I = L - 1
      GO TO 10
*
  570 CONTINUE
      CALL ZGSUM2D( CONTXT, 'All', ' ', N, 1, W, N, -1, -1 )
      RETURN
*
*     END OF PZLAHQR
*
      END