From patchwork Wed Jun 11 12:14:40 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Garlick X-Patchwork-Id: 43058 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 6632327BC4B; Wed, 11 Jun 2025 13:17:46 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,UPPERCASE_50_75,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9F53027BC49 for ; Wed, 11 Jun 2025 13:17:43 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uPKO8-00084T-T8; Wed, 11 Jun 2025 08:17:05 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1uPKO7-000848-Ai for guix-patches@gnu.org; Wed, 11 Jun 2025 08:17:03 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1uPKO6-0007Pj-UY for guix-patches@gnu.org; Wed, 11 Jun 2025 08:17:03 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:From:To:Subject; bh=yHxGvspLcdsSYxhTldqqmh3skau7D1GqJXpPAC/RXZU=; b=Imid1RHp0r9ZY+xyc2sLlV7vcia6MlKxpNYCswxntAA1FHhgiJd9zb4fhpsy6kMKB9VxpInaidHd3I+bqpyfWuuSiUQryuoCTFF04juw1IrZb2/jhZB7LfdQM2zPf+JRxeYt6Dlt3YCswb2U+lgDPsLejcScxyqkoYq6VMxyabtWLpRdNz5WgvDzIylpFBx1m4k2p6kTaZpvxUIDjecNZAn2JBGvMxmMkCExNh27NWh6DN96cJ3OLZejMepmhwNb6Glgte89ChezWYQGNXbWQZHGj60+9n2yegDfFwyk+W+2hIKlHFSOoZrfDIhiUUNEgLzheJ/i4dNb76ohJ3atEw==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uPKO6-0002GH-KJ for guix-patches@gnu.org; Wed, 11 Jun 2025 08:17:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#78755] [PATCH] gnu: scalapack: Update to 2.2.2. Resent-From: Paul Garlick Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 11 Jun 2025 12:17:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 78755 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 78755@debbugs.gnu.org Cc: Paul Garlick X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.17496442048639 (code B ref -1); Wed, 11 Jun 2025 12:17:02 +0000 Received: (at submit) by debbugs.gnu.org; 11 Jun 2025 12:16:44 +0000 Received: from localhost ([127.0.0.1]:47892 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uPKNo-0002FG-3i for submit@debbugs.gnu.org; Wed, 11 Jun 2025 08:16:44 -0400 Received: from lists.gnu.org ([2001:470:142::17]:37956) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uPKNl-0002Em-Qt for submit@debbugs.gnu.org; Wed, 11 Jun 2025 08:16:41 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1uPKNZ-000814-8I for guix-patches@gnu.org; Wed, 11 Jun 2025 08:16:29 -0400 Received: from smtp.hosts.co.uk ([85.233.160.19]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1uPKNS-0007JB-OS for guix-patches@gnu.org; Wed, 11 Jun 2025 08:16:28 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=tourbillion-technology.com; s=2025040300; h=Content-Transfer-Encoding: MIME-Version:Message-Id:Date:Subject:To:From:Reply-To:Content-Type:Content-ID :Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To: Resent-Cc:Resent-Message-ID:In-Reply-To:References; bh=yHxGvspLcdsSYxhTldqqmh3skau7D1GqJXpPAC/RXZU=; b=7dMRzQg3UrIpljeTu/3Jy3euBA 1icfHX8NHAod+0UEwjmZOnGQCxgK+1x2cjj3UoC3TNPAm6fujUy7uc/j/5TqclAZHvKnN8wCeCd4X YJzlgWcAnUH8tRhLobx4Cly0JYMcFGnAZ8Lgu1EBxi/jhyIgNtHKoJ4LvH8956++/yPk=; Received: from maikeh336.claranet.co.uk ([79.123.23.187] helo=pumpernickel.tourbillion-technology.com) by smtp.hosts.co.uk with esmtpsa (TLS1.3:TLS_AES_256_GCM_SHA384:256) (Exim) (envelope-from ) id 1uPKNC-000000003So-4MX6; Wed, 11 Jun 2025 13:16:13 +0100 From: Paul Garlick Date: Wed, 11 Jun 2025 13:14:40 +0100 Message-Id: <20250611121440.1955922-1-pgarlick@tourbillion-technology.com> X-Mailer: git-send-email 2.39.5 MIME-Version: 1.0 Received-SPF: pass client-ip=85.233.160.19; envelope-from=pgarlick@tourbillion-technology.com; helo=smtp.hosts.co.uk X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H3=0.001, RCVD_IN_MSPIKE_WL=0.001, RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, RCVD_IN_VALIDITY_SAFE_BLOCKED=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, UPPERCASE_50_75=0.008 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * gnu/packages/maths.scm (scalapack): Update to 2.2.2. Use git-fetch. : Update URL. Remove patch. : Update list of failing tests. * gnu/local.mk: Unregister patch. * gnu/packages/patches/scalapack-gcc-10-compilation.patch: Delete file. --- gnu/local.mk | 1 - gnu/packages/maths.scm | 24 +- .../scalapack-gcc-10-compilation.patch | 5684 ----------------- 3 files changed, 12 insertions(+), 5697 deletions(-) delete mode 100644 gnu/packages/patches/scalapack-gcc-10-compilation.patch diff --git a/gnu/local.mk b/gnu/local.mk index 2948bfb1bf..4b6c3542e3 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -2250,7 +2250,6 @@ dist_patch_DATA = \ %D%/packages/patches/sbcl-lack-fix-tests.patch \ %D%/packages/patches/sbcl-png-fix-sbcl-compatibility.patch \ %D%/packages/patches/sbcl-s-sysdeps-bt2.patch \ - %D%/packages/patches/scalapack-gcc-10-compilation.patch \ %D%/packages/patches/scheme48-tests.patch \ %D%/packages/patches/scilab-better-compiler-detection.patch \ %D%/packages/patches/scilab-tbx_build_help.patch \ diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index 74bdfab84c..9b57b64a78 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -1300,16 +1300,17 @@ (define-public clapack (define-public scalapack (package (name "scalapack") - (version "2.1.0") + (version "2.2.2") (source (origin - (method url-fetch) - (uri (string-append "http://www.netlib.org/scalapack/scalapack-" - version ".tgz")) + (method git-fetch) + (uri (git-reference + (url "https://github.com/Reference-ScaLAPACK/scalapack") + (commit (string-append "v" version)))) + (file-name (git-file-name name version)) (sha256 (base32 - "19i0h9vdc3zsy58r6fy1vs2kz2l7amifkz0cf926j90xz1n23nb1")) - (patches (search-patches "scalapack-gcc-10-compilation.patch")))) + "0abs4j9iknd3qiyaj06gh00iyki71c2lzpmyv21ncv7f7vy1ccr8")))) (build-system cmake-build-system) (inputs `(("mpi" ,openmpi) @@ -1319,14 +1320,13 @@ (define-public scalapack `(#:configure-flags `("-DBUILD_SHARED_LIBS:BOOL=YES") #:phases (modify-phases %standard-phases (add-before 'check 'mpi-setup - ,%openmpi-setup) - (add-after 'unpack 'skip-faulty-test + ,%openmpi-setup) + (add-after 'unpack 'skip-faulty-tests (lambda _ - ;; FIXME: Skip these two tests that fail to complete for - ;; unknown reasons: - ;; . + ;; FIXME: Skip two tests that fail to complete. See + ;; . (substitute* "TESTING/CMakeLists.txt" - (("^add_test\\(x[sd]hseqr.*" all) + (("^add_test\\(x[cz]heevr.*" all) (string-append "# " all "\n")))))))) (home-page "https://www.netlib.org/scalapack/") (synopsis "Library for scalable numerical linear algebra") diff --git a/gnu/packages/patches/scalapack-gcc-10-compilation.patch b/gnu/packages/patches/scalapack-gcc-10-compilation.patch deleted file mode 100644 index cd6fb61cdf..0000000000 --- a/gnu/packages/patches/scalapack-gcc-10-compilation.patch +++ /dev/null @@ -1,5684 +0,0 @@ -Fix Scalapack compilation with GCC 10+. - -Patches from . - -From 9c909f06cf51a3d00252323ce52aba46cc64ab41 Mon Sep 17 00:00:00 2001 -From: =?UTF-8?q?Tiziano=20M=C3=BCller?= -Date: Thu, 25 Jun 2020 18:36:46 +0200 -Subject: [PATCH] fix argument mismatches in the SRC - ---- - SRC/pclarf.f | 80 +++++++++++++++++----------------- - SRC/pclarfc.f | 88 ++++++++++++++++++------------------- - SRC/pclarz.f | 111 ++++++++++++++++++++++++----------------------- - SRC/pclarzc.f | 115 +++++++++++++++++++++++++------------------------ - SRC/pclattrs.f | 55 +++++++++++------------ - SRC/pclawil.f | 53 +++++++++++------------ - SRC/pctrevc.f | 20 +++++---- - SRC/pdhseqr.f | 36 ++++++++-------- - SRC/pdlacon.f | 36 ++++++++-------- - SRC/pdlarf.f | 80 +++++++++++++++++----------------- - SRC/pdlarz.f | 100 +++++++++++++++++++++--------------------- - SRC/pdlawil.f | 48 ++++++++++----------- - SRC/pdstebz.f | 20 ++++----- - SRC/pdtrord.f | 43 +++++++++++------- - SRC/pdtrsen.f | 24 ++++++----- - SRC/pshseqr.f | 36 ++++++++-------- - SRC/pslacon.f | 36 +++++++++------- - SRC/pslarf.f | 80 +++++++++++++++++----------------- - SRC/pslarz.f | 100 +++++++++++++++++++++--------------------- - SRC/pslawil.f | 50 +++++++++++---------- - SRC/psstebz.f | 20 ++++----- - SRC/pstrord.f | 45 +++++++++++-------- - SRC/pstrsen.f | 22 ++++++---- - SRC/pzlarf.f | 80 +++++++++++++++++----------------- - SRC/pzlarfc.f | 88 ++++++++++++++++++------------------- - SRC/pzlarz.f | 103 +++++++++++++++++++++---------------------- - SRC/pzlarzc.f | 111 ++++++++++++++++++++++++----------------------- - SRC/pzlattrs.f | 55 +++++++++++------------ - SRC/pzlawil.f | 49 +++++++++++---------- - SRC/pztrevc.f | 20 +++++---- - 30 files changed, 927 insertions(+), 877 deletions(-) - -diff --git a/SRC/pclarf.f b/SRC/pclarf.f -index f941e46..371f710 100644 ---- a/SRC/pclarf.f -+++ b/SRC/pclarf.f -@@ -242,7 +242,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, - $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, - $ NQ, RDEST -- COMPLEX TAULOC -+ COMPLEX TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, CCOPY, CGEBR2D, CGEBS2D, -@@ -336,7 +336,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -345,7 +345,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -363,8 +363,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -379,9 +379,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYCOL.EQ.ICCOL ) THEN - * -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -398,7 +398,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL CGERC( MP, NQ, -TAULOC, V( IOFFV ), 1, -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, - $ WORK, 1, C( IOFFC ), LDC ) - END IF - * -@@ -421,9 +421,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = MP+1 - CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -441,7 +441,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * -@@ -471,7 +471,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -480,7 +480,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -500,8 +500,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - v * w' - * - IF( IOFFC.GT.0 ) -- $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -516,18 +516,18 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( JJV ) - CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * - IPW = MP+1 - CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -547,8 +547,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - v * w' - * - IF( IOFFC.GT.0 ) -- $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -577,9 +577,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYROW.EQ.ICROW ) THEN - * -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -597,7 +597,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - w * v' - * - IF( IOFFV.GT.0 .AND. IOFFC.GT.0 ) -- $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, -+ $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC ), - $ LDC ) - END IF -@@ -621,9 +621,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = NQ+1 - CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -641,8 +641,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -667,7 +667,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -676,7 +676,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -694,8 +694,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -720,18 +720,18 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( IIV ) - CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * - IPW = NQ+1 - CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -750,8 +750,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - w * v' - * - IF( IOFFC.GT.0 ) -- $ CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -770,7 +770,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -779,7 +779,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -797,8 +797,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, -- $ C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -diff --git a/SRC/pclarfc.f b/SRC/pclarfc.f -index d6a2d3b..f84c493 100644 ---- a/SRC/pclarfc.f -+++ b/SRC/pclarfc.f -@@ -242,7 +242,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, - $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, - $ NQ, RDEST -- COMPLEX TAULOC -+ COMPLEX TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, CCOPY, CGEBR2D, CGEBS2D, -@@ -336,17 +336,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = CONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = CONJG( TAU( IIV ) ) - * - ELSE - * - CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAULOC, 1, IVROW, MYCOL ) -- TAULOC = CONJG( TAULOC ) -+ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -364,8 +364,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -380,9 +380,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYCOL.EQ.ICCOL ) THEN - * -- TAULOC = CONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = CONJG( TAU( JJV ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -399,7 +399,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL CGERC( MP, NQ, -TAULOC, V( IOFFV ), 1, -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, - $ WORK, 1, C( IOFFC ), LDC ) - END IF - * -@@ -422,9 +422,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = MP+1 - CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = CONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = CONJG( WORK( IPW ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -442,7 +442,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * -@@ -472,17 +472,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = CONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = CONJG( TAU( IIV ) ) - * - ELSE - * - CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, - $ 1, IVROW, MYCOL ) -- TAULOC = CONJG( TAULOC ) -+ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -500,8 +500,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1, -- $ C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -516,18 +516,18 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( JJV ) - CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = CONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = CONJG( TAU( JJV ) ) - * - ELSE - * - IPW = MP+1 - CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = CONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = CONJG( WORK( IPW ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -545,8 +545,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1, -- $ C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -575,9 +575,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYROW.EQ.ICROW ) THEN - * -- TAULOC = CONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = CONJG( TAU( IIV ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -594,7 +594,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC ), LDC ) - END IF - * -@@ -617,9 +617,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = NQ+1 - CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = CONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = CONJG( WORK( IPW ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -637,8 +637,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -663,17 +663,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = CONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = CONJG( TAU( JJV ) ) - * - ELSE - * - CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, - $ 1, MYROW, IVCOL ) -- TAULOC = CONJG( TAULOC ) -+ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -691,8 +691,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -716,18 +716,18 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( IIV ) - CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = CONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = CONJG( TAU( IIV ) ) - * - ELSE - * - IPW = NQ+1 - CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = CONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = CONJG( WORK( IPW ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -745,8 +745,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, -- $ C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -765,17 +765,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = CONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = CONJG( TAU( JJV ) ) - * - ELSE - * - CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1, - $ MYROW, IVCOL ) -- TAULOC = CONJG( TAULOC ) -+ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -793,8 +793,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, -- $ C( IOFFC ), LDC ) -+ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -diff --git a/SRC/pclarz.f b/SRC/pclarz.f -index 9ba730c..673860a 100644 ---- a/SRC/pclarz.f -+++ b/SRC/pclarz.f -@@ -251,7 +251,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, - $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, - $ NQC2, NQV, RDEST -- COMPLEX TAULOC -+ COMPLEX TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, CAXPY, CCOPY, CGEBR2D, -@@ -370,7 +370,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -379,7 +379,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -402,9 +402,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -420,9 +420,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYCOL.EQ.ICCOL2 ) THEN - * -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -445,11 +445,11 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK, -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK, - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -471,9 +471,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = MPV+1 - CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -496,10 +496,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -530,16 +530,16 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -- CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, -- $ 1, IVROW, MYCOL ) -+ CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, -+ $ TAULOC( 1 ), 1, IVROW, MYCOL ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -562,10 +562,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -580,18 +580,18 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( JJV ) - CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * - IPW = MPV+1 - CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -614,10 +614,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -646,9 +646,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYROW.EQ.ICROW2 ) THEN - * -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -669,13 +669,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ ICCOL2 ) - * - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK, 1, -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK, 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * - IF( MPC2.GT.0 .AND. NQV.GT.0 ) -- $ CALL CGERC( MPC2, NQV, -TAULOC, WORK, 1, -+ $ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC2 ), - $ LDC ) - END IF -@@ -699,9 +699,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = NQV+1 - CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -720,13 +720,14 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), - $ RDEST, ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -- $ C( IOFFC1 ), 1 ) -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), -+ $ WORK( IPW ), 1, WORK, 1, -+ $ C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -751,16 +752,16 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -- CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, -- $ 1, MYROW, IVCOL ) -+ CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, -+ $ TAULOC( 1 ), 1, MYROW, IVCOL ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -779,13 +780,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -809,18 +810,18 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( IIV ) - CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * - IPW = NQV+1 - CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -840,13 +841,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -865,7 +866,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -874,7 +875,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -893,13 +894,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -diff --git a/SRC/pclarzc.f b/SRC/pclarzc.f -index f1bc21e..b6d3b6d 100644 ---- a/SRC/pclarzc.f -+++ b/SRC/pclarzc.f -@@ -251,7 +251,7 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, - $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, - $ NQC2, NQV, RDEST -- COMPLEX TAULOC -+ COMPLEX TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, CAXPY, CCOPY, CGEBR2D, -@@ -370,17 +370,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = CONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = CONJG( TAU( IIV ) ) - * - ELSE - * - CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAULOC, 1, IVROW, MYCOL ) -- TAULOC = CONJG( TAULOC ) -+ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -403,9 +403,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -421,9 +421,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYCOL.EQ.ICCOL2 ) THEN - * -- TAULOC = CONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = CONJG( TAU( JJV ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -446,11 +446,11 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK, -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK, - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -472,9 +472,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = MPV+1 - CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = CONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = CONJG( WORK( IPW ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -497,10 +497,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -531,17 +531,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = CONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = CONJG( TAU( IIV ) ) - * - ELSE - * - CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, - $ 1, IVROW, MYCOL ) -- TAULOC = CONJG( TAULOC ) -+ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -564,10 +564,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -582,18 +582,18 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( JJV ) - CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = CONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = CONJG( TAU( JJV ) ) - * - ELSE - * - IPW = MPV+1 - CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = CONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = CONJG( WORK( IPW ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -616,10 +616,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -648,9 +648,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYROW.EQ.ICROW2 ) THEN - * -- TAULOC = CONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = CONJG( TAU( IIV ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -671,12 +671,12 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ ICCOL2 ) - * - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK, 1, -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK, 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MPC2, NQV, -TAULOC, WORK, 1, -+ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC2 ), LDC ) - END IF - * -@@ -699,9 +699,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = NQV+1 - CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = CONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = CONJG( WORK( IPW ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -720,13 +720,14 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), - $ RDEST, ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -- $ C( IOFFC1 ), 1 ) -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), -+ $ WORK( IPW ), 1, WORK, 1, -+ $ C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -751,17 +752,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = CONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = CONJG( TAU( JJV ) ) - * - ELSE - * - CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, - $ 1, MYROW, IVCOL ) -- TAULOC = CONJG( TAULOC ) -+ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -780,13 +781,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -810,18 +811,18 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( IIV ) - CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = CONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = CONJG( TAU( IIV ) ) - * - ELSE - * - IPW = NQV+1 - CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = CONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = CONJG( WORK( IPW ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -841,13 +842,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -866,17 +867,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = CONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = CONJG( TAU( JJV ) ) - * - ELSE - * -- CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1, -- $ MYROW, IVCOL ) -- TAULOC = CONJG( TAULOC ) -+ CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, -+ $ TAULOC( 1 ), 1, MYROW, IVCOL ) -+ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -895,13 +896,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -diff --git a/SRC/pclattrs.f b/SRC/pclattrs.f -index c744aea..0d12a8b 100644 ---- a/SRC/pclattrs.f -+++ b/SRC/pclattrs.f -@@ -271,7 +271,8 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - $ JINC, JLAST, LDA, LDX, MB, MYCOL, MYROW, NB, - $ NPCOL, NPROW, RSRC - REAL BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL, -- $ XBND, XJ, XMAX -+ $ XBND, XJ -+ REAL XMAX( 1 ) - COMPLEX CSUMJ, TJJS, USCAL, XJTMP, ZDUM - * .. - * .. External Functions .. -@@ -391,11 +392,11 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - * Compute a bound on the computed solution vector to see if the - * Level 2 PBLAS routine PCTRSV can be used. - * -- XMAX = ZERO -+ XMAX( 1 ) = ZERO - CALL PCAMAX( N, ZDUM, IMAX, X, IX, JX, DESCX, 1 ) -- XMAX = CABS2( ZDUM ) -+ XMAX( 1 ) = CABS2( ZDUM ) - CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, -1, -1 ) -- XBND = XMAX -+ XBND = XMAX( 1 ) - * - IF( NOTRAN ) THEN - * -@@ -590,16 +591,16 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - * - * Use a Level 1 PBLAS solve, scaling intermediate results. - * -- IF( XMAX.GT.BIGNUM*HALF ) THEN -+ IF( XMAX( 1 ).GT.BIGNUM*HALF ) THEN - * - * Scale X so that its components are less than or equal to - * BIGNUM in absolute value. - * -- SCALE = ( BIGNUM*HALF ) / XMAX -+ SCALE = ( BIGNUM*HALF ) / XMAX( 1 ) - CALL PCSSCAL( N, SCALE, X, IX, JX, DESCX, 1 ) -- XMAX = BIGNUM -+ XMAX( 1 ) = BIGNUM - ELSE -- XMAX = XMAX*TWO -+ XMAX( 1 ) = XMAX( 1 )*TWO - END IF - * - IF( NOTRAN ) THEN -@@ -651,7 +652,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * X( J ) = CLADIV( X( J ), TJJS ) -@@ -682,7 +683,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - * X( J ) = CLADIV( X( J ), TJJS ) - * XJ = CABS1( X( J ) ) -@@ -706,7 +707,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - XJTMP = CONE - XJ = ONE - SCALE = ZERO -- XMAX = ZERO -+ XMAX( 1 ) = ZERO - END IF - 90 CONTINUE - * -@@ -715,7 +716,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - * - IF( XJ.GT.ONE ) THEN - REC = ONE / XJ -- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN -+ IF( CNORM( J ).GT.( BIGNUM-XMAX( 1 ) )*REC ) THEN - * - * Scale x by 1/(2*abs(x(j))). - * -@@ -724,7 +725,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - XJTMP = XJTMP*REC - SCALE = SCALE*REC - END IF -- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN -+ ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX( 1 ) ) ) THEN - * - * Scale x by 1/2. - * -@@ -743,7 +744,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCAXPY( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1, X, - $ IX, JX, DESCX, 1 ) - CALL PCAMAX( J-1, ZDUM, IMAX, X, IX, JX, DESCX, 1 ) -- XMAX = CABS1( ZDUM ) -+ XMAX( 1 ) = CABS1( ZDUM ) - CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, - $ -1, -1 ) - END IF -@@ -757,7 +758,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCAXPY( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1, - $ X, IX+J, JX, DESCX, 1 ) - CALL PCAMAX( N-J, ZDUM, I, X, IX+J, JX, DESCX, 1 ) -- XMAX = CABS1( ZDUM ) -+ XMAX( 1 ) = CABS1( ZDUM ) - CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, - $ -1, -1 ) - END IF -@@ -785,7 +786,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - END IF - XJ = CABS1( XJTMP ) - USCAL = CMPLX( TSCAL ) -- REC = ONE / MAX( XMAX, ONE ) -+ REC = ONE / MAX( XMAX( 1 ), ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN - * - * If x(j) could overflow, scale x by 1/(2*XMAX). -@@ -820,7 +821,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * -@@ -924,7 +925,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * X( J ) = CLADIV( X( J ), TJJS ) -@@ -945,7 +946,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - * X( J ) = CLADIV( X( J ), TJJS ) - XJTMP = CLADIV( XJTMP, TJJS ) -@@ -966,7 +967,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - END IF - XJTMP = CONE - SCALE = ZERO -- XMAX = ZERO -+ XMAX( 1 ) = ZERO - END IF - 110 CONTINUE - ELSE -@@ -981,7 +982,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - X( IROWX ) = XJTMP - END IF - END IF -- XMAX = MAX( XMAX, CABS1( XJTMP ) ) -+ XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) ) - 120 CONTINUE - * - ELSE -@@ -1004,7 +1005,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - END IF - XJ = CABS1( XJTMP ) - USCAL = TSCAL -- REC = ONE / MAX( XMAX, ONE ) -+ REC = ONE / MAX( XMAX( 1 ), ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN - * - * If x(j) could overflow, scale x by 1/(2*XMAX). -@@ -1039,7 +1040,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * -@@ -1145,7 +1146,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * X( J ) = CLADIV( X( J ), TJJS ) -@@ -1164,7 +1165,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - * X( J ) = CLADIV( X( J ), TJJS ) - XJTMP = CLADIV( XJTMP, TJJS ) -@@ -1181,7 +1182,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - $ X( IROWX ) = CONE - XJTMP = CONE - SCALE = ZERO -- XMAX = ZERO -+ XMAX( 1 ) = ZERO - END IF - 130 CONTINUE - ELSE -@@ -1194,7 +1195,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) ) - $ X( IROWX ) = XJTMP - END IF -- XMAX = MAX( XMAX, CABS1( XJTMP ) ) -+ XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) ) - 140 CONTINUE - END IF - SCALE = SCALE / TSCAL -diff --git a/SRC/pclawil.f b/SRC/pclawil.f -index 24a49b9..b33b3b1 100644 ---- a/SRC/pclawil.f -+++ b/SRC/pclawil.f -@@ -124,11 +124,10 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT, - $ RSRC, UP - REAL S -- COMPLEX CDUM, H11, H12, H21, H22, H33S, H44S, V1, V2, -- $ V3 -+ COMPLEX CDUM, H22, H33S, H44S, V1, V2 - * .. - * .. Local Arrays .. -- COMPLEX BUF( 4 ) -+ COMPLEX BUF( 4 ), V3( 1 ), H11( 1 ), H12( 1 ), H21( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, INFOG2L, CGERV2D, CGESD2D -@@ -181,18 +180,18 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( NPCOL.GT.1 ) THEN - CALL CGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT ) - ELSE -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - IF( NUM.GT.1 ) THEN - CALL CGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT ) -- H11 = BUF( 1 ) -- H21 = BUF( 2 ) -- H12 = BUF( 3 ) -+ H11( 1 ) = BUF( 1 ) -+ H21( 1 ) = BUF( 2 ) -+ H12( 1 ) = BUF( 3 ) - H22 = BUF( 4 ) - ELSE -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) - END IF - END IF -@@ -223,22 +222,22 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, - $ IROW, ICOL, RSRC, JSRC ) - IF( NUM.GT.1 ) THEN -- CALL CGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT ) -+ CALL CGERV2D( CONTXT, 1, 1, H11( 1 ), 1, UP, LEFT ) - ELSE -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) - END IF - IF( NPROW.GT.1 ) THEN - CALL CGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL ) - ELSE -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - END IF - IF( NPCOL.GT.1 ) THEN -- CALL CGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT ) -+ CALL CGERV2D( CONTXT, 1, 1, H21( 1 ), 1, MYROW, LEFT ) - ELSE -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) - END IF - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - END IF - IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) -@@ -247,24 +246,24 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( MODKM1.GT.1 ) THEN - CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, - $ IROW, ICOL, RSRC, JSRC ) -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - * -- H44S = H44 - H11 -- H33S = H33 - H11 -- V1 = ( H33S*H44S-H43H34 ) / H21 + H12 -- V2 = H22 - H11 - H33S - H44S -- S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3 ) -+ H44S = H44 - H11( 1 ) -+ H33S = H33 - H11( 1 ) -+ V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 ) -+ V2 = H22 - H11( 1 ) - H33S - H44S -+ S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3( 1 ) ) - V1 = V1 / S - V2 = V2 / S -- V3 = V3 / S -+ V3( 1 ) = V3( 1 ) / S - V( 1 ) = V1 - V( 2 ) = V2 -- V( 3 ) = V3 -+ V( 3 ) = V3( 1 ) - * - RETURN - * -diff --git a/SRC/pctrevc.f b/SRC/pctrevc.f -index d0a3043..bf6c52b 100644 ---- a/SRC/pctrevc.f -+++ b/SRC/pctrevc.f -@@ -218,11 +218,12 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - $ ITMP2, J, K, KI, LDT, LDVL, LDVR, LDW, MB, - $ MYCOL, MYROW, NB, NPCOL, NPROW, RSRC - REAL SELF -- REAL OVFL, REMAXD, SCALE, SMIN, SMLNUM, ULP, UNFL -+ REAL OVFL, REMAXD, SCALE, SMLNUM, ULP, UNFL - COMPLEX CDUM, REMAXC, SHIFT - * .. - * .. Local Arrays .. - INTEGER DESCW( DLEN_ ) -+ REAL SMIN( 1 ) - * .. - * .. External Functions .. - LOGICAL LSAME -@@ -355,13 +356,13 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - $ GO TO 70 - END IF - * -- SMIN = ZERO -+ SMIN( 1 ) = ZERO - SHIFT = CZERO - CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL, - $ IROW, ICOL, ITMP1, ITMP2 ) - IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN - SHIFT = T( ( ICOL-1 )*LDT+IROW ) -- SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) -+ SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) - END IF - CALL SGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 ) - CALL CGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 ) -@@ -396,8 +397,9 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN - T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) - - $ SHIFT -- IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) THEN -- T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN ) -+ IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) ) -+ $ THEN -+ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN( 1 ) ) - END IF - END IF - 50 CONTINUE -@@ -467,13 +469,13 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - $ GO TO 110 - END IF - * -- SMIN = ZERO -+ SMIN( 1 ) = ZERO - SHIFT = CZERO - CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL, - $ IROW, ICOL, ITMP1, ITMP2 ) - IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN - SHIFT = T( ( ICOL-1 )*LDT+IROW ) -- SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) -+ SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) - END IF - CALL SGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 ) - CALL CGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 ) -@@ -507,8 +509,8 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN - T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) - - $ SHIFT -- IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) -- $ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN ) -+ IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) ) -+ $ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN( 1 ) ) - END IF - 90 CONTINUE - * -diff --git a/SRC/pdhseqr.f b/SRC/pdhseqr.f -index ffc3652..6e0f751 100644 ---- a/SRC/pdhseqr.f -+++ b/SRC/pdhseqr.f -@@ -259,11 +259,12 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, - $ HRSRC4, HCSRC4, LIWKOPT - LOGICAL INITZ, LQUERY, WANTT, WANTZ, PAIR, BORDER - DOUBLE PRECISION TMP1, TMP2, TMP3, TMP4, DUM1, DUM2, DUM3, -- $ DUM4, ELEM1, ELEM2, ELEM3, ELEM4, -+ $ DUM4, ELEM1, ELEM4, - $ CS, SN, ELEM5, TMP, LWKOPT - * .. - * .. Local Arrays .. - INTEGER DESCH2( DLEN_ ) -+ DOUBLE PRECISION ELEM2( 1 ), ELEM3( 1 ) - * .. - * .. External Functions .. - INTEGER PILAENVX, NUMROC, ICEIL -@@ -566,28 +567,28 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, - IF( MYROW.EQ.HRSRC1 .AND. MYCOL.EQ.HCSRC1 ) THEN - ELEM1 = H((JLOC1-1)*LLDH+ILOC1) - IF( K.LT.N ) THEN -- ELEM3 = H((JLOC1-1)*LLDH+ILOC1+1) -+ ELEM3( 1 ) = H((JLOC1-1)*LLDH+ILOC1+1) - ELSE -- ELEM3 = ZERO -+ ELEM3( 1 ) = ZERO - END IF -- IF( ELEM3.NE.ZERO ) THEN -- ELEM2 = H((JLOC1)*LLDH+ILOC1) -+ IF( ELEM3( 1 ).NE.ZERO ) THEN -+ ELEM2( 1 ) = H((JLOC1)*LLDH+ILOC1) - ELEM4 = H((JLOC1)*LLDH+ILOC1+1) -- CALL DLANV2( ELEM1, ELEM2, ELEM3, ELEM4, -- $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), -- $ SN, CS ) -+ CALL DLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), -+ $ ELEM4, WR( K ), WI( K ), WR( K+1 ), -+ $ WI( K+1 ), SN, CS ) - PAIR = .TRUE. - ELSE - IF( K.GT.1 ) THEN - TMP = H((JLOC1-2)*LLDH+ILOC1) - IF( TMP.NE.ZERO ) THEN - ELEM1 = H((JLOC1-2)*LLDH+ILOC1-1) -- ELEM2 = H((JLOC1-1)*LLDH+ILOC1-1) -- ELEM3 = H((JLOC1-2)*LLDH+ILOC1) -+ ELEM2( 1 ) = H((JLOC1-1)*LLDH+ILOC1-1) -+ ELEM3( 1 ) = H((JLOC1-2)*LLDH+ILOC1) - ELEM4 = H((JLOC1-1)*LLDH+ILOC1) -- CALL DLANV2( ELEM1, ELEM2, ELEM3, -- $ ELEM4, WR( K-1 ), WI( K-1 ), -- $ WR( K ), WI( K ), SN, CS ) -+ CALL DLANV2( ELEM1, ELEM2( 1 ), -+ $ ELEM3( 1 ), ELEM4, WR( K-1 ), -+ $ WI( K-1 ), WR( K ), WI( K ), SN, CS ) - ELSE - WR( K ) = ELEM1 - END IF -@@ -620,12 +621,12 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, - CALL INFOG2L( K+1, K+1, DESCH, NPROW, NPCOL, MYROW, MYCOL, - $ ILOC4, JLOC4, HRSRC4, HCSRC4 ) - IF( MYROW.EQ.HRSRC2 .AND. MYCOL.EQ.HCSRC2 ) THEN -- ELEM2 = H((JLOC2-1)*LLDH+ILOC2) -+ ELEM2( 1 ) = H((JLOC2-1)*LLDH+ILOC2) - IF( HRSRC1.NE.HRSRC2 .OR. HCSRC1.NE.HCSRC2 ) - $ CALL DGESD2D( ICTXT, 1, 1, ELEM2, 1, HRSRC1, HCSRC1) - END IF - IF( MYROW.EQ.HRSRC3 .AND. MYCOL.EQ.HCSRC3 ) THEN -- ELEM3 = H((JLOC3-1)*LLDH+ILOC3) -+ ELEM3( 1 ) = H((JLOC3-1)*LLDH+ILOC3) - IF( HRSRC1.NE.HRSRC3 .OR. HCSRC1.NE.HCSRC3 ) - $ CALL DGESD2D( ICTXT, 1, 1, ELEM3, 1, HRSRC1, HCSRC1) - END IF -@@ -651,8 +652,9 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, - ELEM5 = WORK(2) - IF( ELEM5.EQ.ZERO ) THEN - IF( WR( K ).EQ.ZERO .AND. WI( K ).EQ.ZERO ) THEN -- CALL DLANV2( ELEM1, ELEM2, ELEM3, ELEM4, WR( K ), -- $ WI( K ), WR( K+1 ), WI( K+1 ), SN, CS ) -+ CALL DLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ELEM4, -+ $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), SN, -+ $ CS ) - ELSEIF( WR( K+1 ).EQ.ZERO .AND. WI( K+1 ).EQ.ZERO ) - $ THEN - WR( K+1 ) = ELEM4 -diff --git a/SRC/pdlacon.f b/SRC/pdlacon.f -index b625d97..74b9eab 100644 ---- a/SRC/pdlacon.f -+++ b/SRC/pdlacon.f -@@ -160,10 +160,10 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - INTEGER I, ICTXT, IFLAG, IIVX, IMAXROW, IOFFVX, IROFF, - $ ITER, IVXCOL, IVXROW, J, JLAST, JJVX, JUMP, - $ K, MYCOL, MYROW, NP, NPCOL, NPROW -- DOUBLE PRECISION ALTSGN, ESTOLD, JLMAX, TEMP, XMAX -+ DOUBLE PRECISION ALTSGN, ESTOLD, JLMAX, XMAX - * .. - * .. Local Arrays .. -- DOUBLE PRECISION WORK( 2 ) -+ DOUBLE PRECISION ESTWORK( 1 ), TEMP( 1 ), WORK( 2 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, DCOPY, DGEBR2D, DGEBS2D, -@@ -184,6 +184,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - * - * Get grid parameters. - * -+ ESTWORK( 1 ) = EST - ICTXT = DESCX( CTXT_ ) - CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) - * -@@ -215,21 +216,21 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - IF( N.EQ.1 ) THEN - IF( MYROW.EQ.IVXROW ) THEN - V( IOFFVX ) = X( IOFFVX ) -- EST = ABS( V( IOFFVX ) ) -- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) -+ ESTWORK( 1 ) = ABS( V( IOFFVX ) ) -+ CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) - ELSE -- CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, -+ CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, - $ IVXROW, MYCOL ) - END IF - * ... QUIT - GO TO 150 - END IF -- CALL PDASUM( N, EST, X, IX, JX, DESCX, 1 ) -+ CALL PDASUM( N, ESTWORK( 1 ), X, IX, JX, DESCX, 1 ) - IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN - IF( MYROW.EQ.IVXROW ) THEN -- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) -+ CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) - ELSE -- CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, -+ CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, - $ IVXROW, MYCOL ) - END IF - END IF -@@ -281,13 +282,13 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - * - 70 CONTINUE - CALL DCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 ) -- ESTOLD = EST -- CALL PDASUM( N, EST, V, IV, JV, DESCV, 1 ) -+ ESTOLD = ESTWORK( 1 ) -+ CALL PDASUM( N, ESTWORK( 1 ), V, IV, JV, DESCV, 1 ) - IF( DESCV( M_ ).EQ.1 .AND. N.EQ.1 ) THEN - IF( MYROW.EQ.IVXROW ) THEN -- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) -+ CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) - ELSE -- CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, -+ CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, - $ IVXROW, MYCOL ) - END IF - END IF -@@ -305,7 +306,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. - * ALONG WITH IT, TEST FOR CYCLING. - * -- IF( IFLAG.EQ.0 .OR. EST.LE.ESTOLD ) -+ IF( IFLAG.EQ.0 .OR. ESTWORK( 1 ).LE.ESTOLD ) - $ GO TO 120 - * - DO 100 I = IOFFVX, IOFFVX+NP-1 -@@ -361,7 +362,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - * X HAS BEEN OVERWRITTEN BY A*X - * - 140 CONTINUE -- CALL PDASUM( N, TEMP, X, IX, JX, DESCX, 1 ) -+ CALL PDASUM( N, TEMP( 1 ), X, IX, JX, DESCX, 1 ) - IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN - IF( MYROW.EQ.IVXROW ) THEN - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, TEMP, 1 ) -@@ -370,15 +371,16 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - $ IVXROW, MYCOL ) - END IF - END IF -- TEMP = TWO*( TEMP / DBLE( 3*N ) ) -- IF( TEMP.GT.EST ) THEN -+ TEMP( 1 ) = TWO*( TEMP( 1 ) / DBLE( 3*N ) ) -+ IF( TEMP( 1 ).GT.ESTWORK( 1 ) ) THEN - CALL DCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 ) -- EST = TEMP -+ ESTWORK( 1 ) = TEMP( 1 ) - END IF - * - 150 CONTINUE - KASE = 0 - * -+ EST = ESTWORK( 1 ) - RETURN - * - * End of PDLACON -diff --git a/SRC/pdlarf.f b/SRC/pdlarf.f -index 29da1ac..41368d6 100644 ---- a/SRC/pdlarf.f -+++ b/SRC/pdlarf.f -@@ -241,7 +241,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, - $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, - $ NQ, RDEST -- DOUBLE PRECISION TAULOC -+ DOUBLE PRECISION TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, DCOPY, DGEBR2D, DGEBS2D, -@@ -335,7 +335,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -344,7 +344,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -362,8 +362,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -378,9 +378,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYCOL.EQ.ICCOL ) THEN - * -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -397,8 +397,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL DGER( MP, NQ, -TAULOC, V( IOFFV ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ CALL DGER( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -420,9 +420,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = MP+1 - CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -440,7 +440,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL DGER( MP, NQ, -TAULOC, WORK, 1, -+ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * -@@ -470,7 +470,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -479,7 +479,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -499,8 +499,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - v * w' - * - IF( IOFFC.GT.0 ) -- $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -515,18 +515,18 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( JJV ) - CALL DGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * - IPW = MP+1 - CALL DGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -546,8 +546,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - v * w' - * - IF( IOFFC.GT.0 ) -- $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -576,9 +576,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYROW.EQ.ICROW ) THEN - * -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -596,7 +596,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - w * v' - * - IF( IOFFV.GT.0 .AND. IOFFC.GT.0 ) -- $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, -+ $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC ), LDC ) - END IF - * -@@ -619,9 +619,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = NQ+1 - CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -639,7 +639,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, -+ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, - $ WORK, 1, C( IOFFC ), LDC ) - END IF - * -@@ -665,7 +665,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -674,7 +674,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -692,8 +692,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -718,18 +718,18 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( IIV ) - CALL DGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * - IPW = NQ+1 - CALL DGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -748,8 +748,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - w * v' - * - IF( IOFFC.GT.0 ) -- $ CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -768,7 +768,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -777,7 +777,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -795,8 +795,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, -- $ C( IOFFC ), LDC ) -+ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, WORK, -+ $ 1, C( IOFFC ), LDC ) - END IF - * - END IF -diff --git a/SRC/pdlarz.f b/SRC/pdlarz.f -index b91282c..f45c137 100644 ---- a/SRC/pdlarz.f -+++ b/SRC/pdlarz.f -@@ -250,7 +250,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, - $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, - $ NQC2, NQV, RDEST -- DOUBLE PRECISION TAULOC -+ DOUBLE PRECISION TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, DAXPY, DCOPY, DGEBR2D, -@@ -369,7 +369,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -378,7 +378,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -401,9 +401,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -419,9 +419,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYCOL.EQ.ICCOL2 ) THEN - * -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -444,11 +444,11 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL DAXPY( NQC2, -TAULOC, WORK, -+ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK, - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL DGER( MPV, NQC2, -TAULOC, V( IOFFV ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL DGER( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -470,9 +470,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = MPV+1 - CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -495,10 +495,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -529,7 +529,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -538,7 +538,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -561,10 +561,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -579,18 +579,18 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( JJV ) - CALL DGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * - IPW = MPV+1 - CALL DGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -613,10 +613,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -645,9 +645,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYROW.EQ.ICROW2 ) THEN - * -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -668,13 +668,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ ICCOL2 ) - * - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL DAXPY( MPC2, -TAULOC, WORK, 1, -+ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK, 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * - IF( MPC2.GT.0 .AND. NQV.GT.0 ) -- $ CALL DGER( MPC2, NQV, -TAULOC, WORK, 1, -+ $ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC2 ), - $ LDC ) - END IF -@@ -698,9 +698,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = NQV+1 - CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -719,13 +719,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), - $ RDEST, ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -- $ C( IOFFC1 ), 1 ) -+ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -750,7 +750,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -759,7 +759,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -778,12 +778,12 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -+ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, - $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -808,18 +808,18 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( IIV ) - CALL DGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * - IPW = NQV+1 - CALL DGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -839,13 +839,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -864,7 +864,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -873,7 +873,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -892,13 +892,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -diff --git a/SRC/pdlawil.f b/SRC/pdlawil.f -index 90a4d74..e8bc3a0 100644 ---- a/SRC/pdlawil.f -+++ b/SRC/pdlawil.f -@@ -120,10 +120,10 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - INTEGER CONTXT, DOWN, HBL, ICOL, IROW, JSRC, LDA, LEFT, - $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT, - $ RSRC, UP -- DOUBLE PRECISION H11, H12, H21, H22, H33S, H44S, S, V1, V2, V3 -+ DOUBLE PRECISION H22, H33S, H44S, S, V1, V2 - * .. - * .. Local Arrays .. -- DOUBLE PRECISION BUF( 4 ) -+ DOUBLE PRECISION BUF( 4 ), H11( 1 ), H12( 1 ), H21( 1 ), V3( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, DGERV2D, DGESD2D, INFOG2L -@@ -170,18 +170,18 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( NPCOL.GT.1 ) THEN - CALL DGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT ) - ELSE -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - IF( NUM.GT.1 ) THEN - CALL DGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT ) -- H11 = BUF( 1 ) -- H21 = BUF( 2 ) -- H12 = BUF( 3 ) -+ H11( 1 ) = BUF( 1 ) -+ H21( 1 ) = BUF( 2 ) -+ H12( 1 ) = BUF( 3 ) - H22 = BUF( 4 ) - ELSE -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) - END IF - END IF -@@ -214,20 +214,20 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( NUM.GT.1 ) THEN - CALL DGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT ) - ELSE -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) - END IF - IF( NPROW.GT.1 ) THEN - CALL DGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL ) - ELSE -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - END IF - IF( NPCOL.GT.1 ) THEN - CALL DGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT ) - ELSE -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) - END IF - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - END IF - IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) -@@ -236,24 +236,24 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( MODKM1.GT.1 ) THEN - CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, - $ IROW, ICOL, RSRC, JSRC ) -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - * -- H44S = H44 - H11 -- H33S = H33 - H11 -- V1 = ( H33S*H44S-H43H34 ) / H21 + H12 -- V2 = H22 - H11 - H33S - H44S -- S = ABS( V1 ) + ABS( V2 ) + ABS( V3 ) -+ H44S = H44 - H11( 1 ) -+ H33S = H33 - H11( 1 ) -+ V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 ) -+ V2 = H22 - H11( 1 ) - H33S - H44S -+ S = ABS( V1 ) + ABS( V2 ) + ABS( V3( 1 ) ) - V1 = V1 / S - V2 = V2 / S -- V3 = V3 / S -+ V3( 1 ) = V3( 1 ) / S - V( 1 ) = V1 - V( 2 ) = V2 -- V( 3 ) = V3 -+ V( 3 ) = V3( 1 ) - * - RETURN - * -diff --git a/SRC/pdstebz.f b/SRC/pdstebz.f -index e7006f9..bf4dacc 100644 ---- a/SRC/pdstebz.f -+++ b/SRC/pdstebz.f -@@ -246,14 +246,14 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, - $ ITMP2, J, JB, K, LAST, LEXTRA, LREQ, MYCOL, - $ MYROW, NALPHA, NBETA, NCMP, NEIGINT, NEXT, NGL, - $ NGLOB, NGU, NINT, NPCOL, NPROW, OFFSET, -- $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF, -- $ TORECV -+ $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF - DOUBLE PRECISION ALPHA, ATOLI, BETA, BNORM, DRECV, DSEND, GL, - $ GU, INITVL, INITVU, LSAVE, MID, PIVMIN, RELTOL, - $ SAFEMN, TMP1, TMP2, TNORM, ULP - * .. - * .. Local Arrays .. - INTEGER IDUM( 5, 2 ) -+ INTEGER TORECV( 1, 1 ) - * .. - * .. Executable Statements .. - * This is just to keep ftnchek happy -@@ -784,14 +784,14 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, - ELSE - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', 1, 1, TORECV, 1, 0, - $ I-1 ) -- IF( TORECV.NE.0 ) THEN -- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, IWORK, -- $ TORECV, 0, I-1 ) -- CALL DGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, WORK, -- $ TORECV, 0, I-1 ) -- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, -- $ IWORK( N+1 ), TORECV, 0, I-1 ) -- DO 120 J = 1, TORECV -+ IF( TORECV( 1, 1 ).NE.0 ) THEN -+ CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, -+ $ IWORK, TORECV( 1, 1 ), 0, I-1 ) -+ CALL DGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, -+ $ WORK, TORECV( 1, 1 ), 0, I-1 ) -+ CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, -+ $ IWORK( N+1 ), TORECV( 1, 1 ), 0, I-1 ) -+ DO 120 J = 1, TORECV( 1, 1 ) - W( IWORK( J ) ) = WORK( J ) - IBLOCK( IWORK( J ) ) = IWORK( N+J ) - 120 CONTINUE -diff --git a/SRC/pdtrord.f b/SRC/pdtrord.f -index 1f37d8e..3870574 100644 ---- a/SRC/pdtrord.f -+++ b/SRC/pdtrord.f -@@ -328,12 +328,13 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - $ EAST, WEST, ILOC4, SOUTH, NORTH, INDXS, - $ ITT, JTT, ILEN, DLEN, INDXE, TRSRC1, TCSRC1, - $ TRSRC2, TCSRC2, ILOS, DIR, TLIHI, TLILO, TLSEL, -- $ ROUND, LAST, WIN0S, WIN0E, WINE, MMAX, MMIN -+ $ ROUND, LAST, WIN0S, WIN0E, WINE - DOUBLE PRECISION ELEM, ELEM1, ELEM2, ELEM3, ELEM4, SN, CS, TMP, - $ ELEM5 - * .. - * .. Local Arrays .. -- INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ) -+ INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ), MMAX( 1 ), -+ $ MMIN( 1 ), INFODUM( 1 ) - * .. - * .. External Functions .. - LOGICAL LSAME -@@ -483,16 +484,16 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - END IF - IF( SELECT(K).NE.0 ) M = M + 1 - 10 CONTINUE -- MMAX = M -- MMIN = M -+ MMAX( 1 ) = M -+ MMIN( 1 ) = M - IF( NPROCS.GT.1 ) - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1, - $ -1, -1, -1, -1 ) - IF( NPROCS.GT.1 ) - $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1, - $ -1, -1, -1, -1 ) -- IF( MMAX.GT.MMIN ) THEN -- M = MMAX -+ IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN -+ M = MMAX( 1 ) - IF( NPROCS.GT.1 ) - $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, SELECT, N, - $ -1, -1, -1, -1, -1 ) -@@ -520,9 +521,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * - * Global maximum on info. - * -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, -1, - $ -1, -1 ) -+ INFO = INFODUM( 1 ) -+ END IF - * - * Return if some argument is incorrect. - * -@@ -1576,9 +1579,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * experienced a failure in the reordering. - * - MYIERR = IERR -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, - $ -1, -1, -1, -1 ) -+ IERR = INFODUM( 1 ) -+ END IF - * - IF( IERR.NE.0 ) THEN - * -@@ -1586,9 +1591,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * to swap. - * - IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1) -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, - $ -1, -1, -1, -1 ) -+ INFO = INFODUM( 1 ) -+ END IF - GO TO 300 - END IF - * -@@ -3245,9 +3252,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * experienced a failure in the reordering. - * - MYIERR = IERR -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, - $ -1, -1, -1, -1 ) -+ IERR = INFODUM( 1 ) -+ END IF - * - IF( IERR.NE.0 ) THEN - * -@@ -3255,9 +3264,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * to swap. - * - IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1) -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, - $ -1, -1, -1, -1 ) -+ IERR = INFODUM( 1 ) -+ END IF - GO TO 300 - END IF - * -diff --git a/SRC/pdtrsen.f b/SRC/pdtrsen.f -index 78c5599..c65ea91 100644 ---- a/SRC/pdtrsen.f -+++ b/SRC/pdtrsen.f -@@ -354,13 +354,15 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, - LOGICAL LQUERY, WANTBH, WANTQ, WANTS, WANTSP - INTEGER ICOFFT12, ICTXT, IDUM1, IDUM2, IERR, ILOC1, - $ IPW1, ITER, ITT, JLOC1, JTT, K, LIWMIN, LLDT, -- $ LLDQ, LWMIN, MMAX, MMIN, MYROW, MYCOL, N1, N2, -+ $ LLDQ, LWMIN, MYROW, MYCOL, N1, N2, - $ NB, NOEXSY, NPCOL, NPROCS, NPROW, SPACE, - $ T12ROWS, T12COLS, TCOLS, TCSRC, TROWS, TRSRC, - $ WRK1, IWRK1, WRK2, IWRK2, WRK3, IWRK3 -- DOUBLE PRECISION DPDUM1, ELEM, EST, SCALE, RNORM -+ DOUBLE PRECISION ELEM, EST, SCALE, RNORM - * .. Local Arrays .. -- INTEGER DESCT12( DLEN_ ), MBNB2( 2 ) -+ INTEGER DESCT12( DLEN_ ), MBNB2( 2 ), MMAX( 1 ), -+ $ MMIN( 1 ) -+ DOUBLE PRECISION DPDUM1( 1 ) - * .. - * .. External Functions .. - LOGICAL LSAME -@@ -521,16 +523,16 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, - END IF - IF( SELECT(K) ) M = M + 1 - 10 CONTINUE -- MMAX = M -- MMIN = M -+ MMAX( 1 ) = M -+ MMIN( 1 ) = M - IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1, -- $ -1, -1, -1, -1 ) -+ $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX( 1 ), 1, -+ $ -1, -1, -1, -1, -1 ) - IF( NPROCS.GT.1 ) -- $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1, -- $ -1, -1, -1, -1 ) -- IF( MMAX.GT.MMIN ) THEN -- M = MMAX -+ $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN( 1 ), 1, -+ $ -1, -1, -1, -1, -1 ) -+ IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN -+ M = MMAX( 1 ) - IF( NPROCS.GT.1 ) - $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, IWORK, N, - $ -1, -1, -1, -1, -1 ) -diff --git a/SRC/pshseqr.f b/SRC/pshseqr.f -index 10eb24a..e8ecea9 100644 ---- a/SRC/pshseqr.f -+++ b/SRC/pshseqr.f -@@ -259,11 +259,12 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, - $ HRSRC4, HCSRC4, LIWKOPT - LOGICAL INITZ, LQUERY, WANTT, WANTZ, PAIR, BORDER - REAL TMP1, TMP2, TMP3, TMP4, DUM1, DUM2, DUM3, -- $ DUM4, ELEM1, ELEM2, ELEM3, ELEM4, -+ $ DUM4, ELEM1, ELEM4, - $ CS, SN, ELEM5, TMP, LWKOPT - * .. - * .. Local Arrays .. - INTEGER DESCH2( DLEN_ ) -+ REAL ELEM2( 1 ), ELEM3( 1 ) - * .. - * .. External Functions .. - INTEGER PILAENVX, NUMROC, ICEIL -@@ -566,28 +567,28 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, - IF( MYROW.EQ.HRSRC1 .AND. MYCOL.EQ.HCSRC1 ) THEN - ELEM1 = H((JLOC1-1)*LLDH+ILOC1) - IF( K.LT.N ) THEN -- ELEM3 = H((JLOC1-1)*LLDH+ILOC1+1) -+ ELEM3( 1 ) = H((JLOC1-1)*LLDH+ILOC1+1) - ELSE -- ELEM3 = ZERO -+ ELEM3( 1 ) = ZERO - END IF -- IF( ELEM3.NE.ZERO ) THEN -- ELEM2 = H((JLOC1)*LLDH+ILOC1) -+ IF( ELEM3( 1 ).NE.ZERO ) THEN -+ ELEM2( 1 ) = H((JLOC1)*LLDH+ILOC1) - ELEM4 = H((JLOC1)*LLDH+ILOC1+1) -- CALL SLANV2( ELEM1, ELEM2, ELEM3, ELEM4, -- $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), -- $ SN, CS ) -+ CALL SLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), -+ $ ELEM4, WR( K ), WI( K ), WR( K+1 ), -+ $ WI( K+1 ), SN, CS ) - PAIR = .TRUE. - ELSE - IF( K.GT.1 ) THEN - TMP = H((JLOC1-2)*LLDH+ILOC1) - IF( TMP.NE.ZERO ) THEN - ELEM1 = H((JLOC1-2)*LLDH+ILOC1-1) -- ELEM2 = H((JLOC1-1)*LLDH+ILOC1-1) -- ELEM3 = H((JLOC1-2)*LLDH+ILOC1) -+ ELEM2( 1 ) = H((JLOC1-1)*LLDH+ILOC1-1) -+ ELEM3( 1 ) = H((JLOC1-2)*LLDH+ILOC1) - ELEM4 = H((JLOC1-1)*LLDH+ILOC1) -- CALL SLANV2( ELEM1, ELEM2, ELEM3, -- $ ELEM4, WR( K-1 ), WI( K-1 ), -- $ WR( K ), WI( K ), SN, CS ) -+ CALL SLANV2( ELEM1, ELEM2( 1 ), -+ $ ELEM3( 1 ), ELEM4, WR( K-1 ), -+ $ WI( K-1 ), WR( K ), WI( K ), SN, CS ) - ELSE - WR( K ) = ELEM1 - END IF -@@ -620,12 +621,12 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, - CALL INFOG2L( K+1, K+1, DESCH, NPROW, NPCOL, MYROW, MYCOL, - $ ILOC4, JLOC4, HRSRC4, HCSRC4 ) - IF( MYROW.EQ.HRSRC2 .AND. MYCOL.EQ.HCSRC2 ) THEN -- ELEM2 = H((JLOC2-1)*LLDH+ILOC2) -+ ELEM2( 1 ) = H((JLOC2-1)*LLDH+ILOC2) - IF( HRSRC1.NE.HRSRC2 .OR. HCSRC1.NE.HCSRC2 ) - $ CALL SGESD2D( ICTXT, 1, 1, ELEM2, 1, HRSRC1, HCSRC1) - END IF - IF( MYROW.EQ.HRSRC3 .AND. MYCOL.EQ.HCSRC3 ) THEN -- ELEM3 = H((JLOC3-1)*LLDH+ILOC3) -+ ELEM3( 1 ) = H((JLOC3-1)*LLDH+ILOC3) - IF( HRSRC1.NE.HRSRC3 .OR. HCSRC1.NE.HCSRC3 ) - $ CALL SGESD2D( ICTXT, 1, 1, ELEM3, 1, HRSRC1, HCSRC1) - END IF -@@ -651,8 +652,9 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, - ELEM5 = WORK(2) - IF( ELEM5.EQ.ZERO ) THEN - IF( WR( K ).EQ.ZERO .AND. WI( K ).EQ.ZERO ) THEN -- CALL SLANV2( ELEM1, ELEM2, ELEM3, ELEM4, WR( K ), -- $ WI( K ), WR( K+1 ), WI( K+1 ), SN, CS ) -+ CALL SLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ELEM4, -+ $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), SN, -+ $ CS ) - ELSEIF( WR( K+1 ).EQ.ZERO .AND. WI( K+1 ).EQ.ZERO ) - $ THEN - WR( K+1 ) = ELEM4 -diff --git a/SRC/pslacon.f b/SRC/pslacon.f -index 20d27ff..673bf1a 100644 ---- a/SRC/pslacon.f -+++ b/SRC/pslacon.f -@@ -160,10 +160,12 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - INTEGER I, ICTXT, IFLAG, IIVX, IMAXROW, IOFFVX, IROFF, - $ ITER, IVXCOL, IVXROW, J, JLAST, JJVX, JUMP, - $ K, MYCOL, MYROW, NP, NPCOL, NPROW -- REAL ALTSGN, ESTOLD, JLMAX, TEMP, XMAX -+ REAL ALTSGN, ESTOLD, JLMAX, XMAX - * .. - * .. Local Arrays .. - REAL WORK( 2 ) -+ REAL ESTWORK( 1 ) -+ REAL TEMP( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, IGSUM2D, INFOG2L, PSAMAX, -@@ -184,6 +186,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - * - * Get grid parameters. - * -+ ESTWORK( 1 ) = EST - ICTXT = DESCX( CTXT_ ) - CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) - * -@@ -215,21 +218,21 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - IF( N.EQ.1 ) THEN - IF( MYROW.EQ.IVXROW ) THEN - V( IOFFVX ) = X( IOFFVX ) -- EST = ABS( V( IOFFVX ) ) -- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) -+ ESTWORK( 1 ) = ABS( V( IOFFVX ) ) -+ CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) - ELSE -- CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, -+ CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, - $ IVXROW, MYCOL ) - END IF - * ... QUIT - GO TO 150 - END IF -- CALL PSASUM( N, EST, X, IX, JX, DESCX, 1 ) -+ CALL PSASUM( N, ESTWORK( 1 ), X, IX, JX, DESCX, 1 ) - IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN - IF( MYROW.EQ.IVXROW ) THEN -- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) -+ CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) - ELSE -- CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, -+ CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, - $ IVXROW, MYCOL ) - END IF - END IF -@@ -281,13 +284,13 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - * - 70 CONTINUE - CALL SCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 ) -- ESTOLD = EST -- CALL PSASUM( N, EST, V, IV, JV, DESCV, 1 ) -+ ESTOLD = ESTWORK( 1 ) -+ CALL PSASUM( N, ESTWORK( 1 ), V, IV, JV, DESCV, 1 ) - IF( DESCV( M_ ).EQ.1 .AND. N.EQ.1 ) THEN - IF( MYROW.EQ.IVXROW ) THEN -- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) -+ CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) - ELSE -- CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, -+ CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, - $ IVXROW, MYCOL ) - END IF - END IF -@@ -305,7 +308,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. - * ALONG WITH IT, TEST FOR CYCLING. - * -- IF( IFLAG.EQ.0 .OR. EST.LE.ESTOLD ) -+ IF( IFLAG.EQ.0 .OR. ESTWORK( 1 ).LE.ESTOLD ) - $ GO TO 120 - * - DO 100 I = IOFFVX, IOFFVX+NP-1 -@@ -361,7 +364,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - * X HAS BEEN OVERWRITTEN BY A*X - * - 140 CONTINUE -- CALL PSASUM( N, TEMP, X, IX, JX, DESCX, 1 ) -+ CALL PSASUM( N, TEMP( 1 ), X, IX, JX, DESCX, 1 ) - IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN - IF( MYROW.EQ.IVXROW ) THEN - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, TEMP, 1 ) -@@ -370,15 +373,16 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, - $ IVXROW, MYCOL ) - END IF - END IF -- TEMP = TWO*( TEMP / REAL( 3*N ) ) -- IF( TEMP.GT.EST ) THEN -+ TEMP( 1 ) = TWO*( TEMP( 1 ) / REAL( 3*N ) ) -+ IF( TEMP( 1 ).GT.ESTWORK( 1 ) ) THEN - CALL SCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 ) -- EST = TEMP -+ ESTWORK( 1 ) = TEMP( 1 ) - END IF - * - 150 CONTINUE - KASE = 0 - * -+ EST = ESTWORK( 1 ) - RETURN - * - * End of PSLACON -diff --git a/SRC/pslarf.f b/SRC/pslarf.f -index c1d3a15..39de0ed 100644 ---- a/SRC/pslarf.f -+++ b/SRC/pslarf.f -@@ -241,7 +241,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, - $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, - $ NQ, RDEST -- REAL TAULOC -+ REAL TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBSTRNV, -@@ -335,7 +335,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -344,7 +344,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -362,8 +362,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -378,9 +378,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYCOL.EQ.ICCOL ) THEN - * -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -397,8 +397,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL SGER( MP, NQ, -TAULOC, V( IOFFV ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ CALL SGER( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -420,9 +420,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = MP+1 - CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -440,7 +440,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL SGER( MP, NQ, -TAULOC, WORK, 1, -+ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * -@@ -470,7 +470,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -479,7 +479,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -499,8 +499,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - v * w' - * - IF( IOFFC.GT.0 ) -- $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -515,18 +515,18 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( JJV ) - CALL SGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * - IPW = MP+1 - CALL SGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -546,8 +546,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - v * w' - * - IF( IOFFC.GT.0 ) -- $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -576,9 +576,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYROW.EQ.ICROW ) THEN - * -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -596,7 +596,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - w * v' - * - IF( IOFFV.GT.0 .AND. IOFFC.GT.0 ) -- $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, -+ $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC ), LDC ) - END IF - * -@@ -619,9 +619,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = NQ+1 - CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -639,7 +639,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, -+ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, - $ WORK, 1, C( IOFFC ), LDC ) - END IF - * -@@ -665,7 +665,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -674,7 +674,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -692,8 +692,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1 -+ $ , WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -718,18 +718,18 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( IIV ) - CALL SGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * - IPW = NQ+1 - CALL SGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -748,8 +748,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - w * v' - * - IF( IOFFC.GT.0 ) -- $ CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -768,7 +768,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -777,7 +777,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -795,8 +795,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, -- $ C( IOFFC ), LDC ) -+ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, WORK, -+ $ 1, C( IOFFC ), LDC ) - END IF - * - END IF -diff --git a/SRC/pslarz.f b/SRC/pslarz.f -index aa70db7..8901530 100644 ---- a/SRC/pslarz.f -+++ b/SRC/pslarz.f -@@ -250,7 +250,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, - $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, - $ NQC2, NQV, RDEST -- REAL TAULOC -+ REAL TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBSTRNV, -@@ -369,7 +369,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -378,7 +378,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -401,9 +401,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -419,9 +419,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYCOL.EQ.ICCOL2 ) THEN - * -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -444,11 +444,11 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL SAXPY( NQC2, -TAULOC, WORK, -+ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK, - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL SGER( MPV, NQC2, -TAULOC, V( IOFFV ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL SGER( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -470,9 +470,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = MPV+1 - CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -495,10 +495,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -529,7 +529,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -538,7 +538,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -561,10 +561,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -579,18 +579,18 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( JJV ) - CALL SGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * - IPW = MPV+1 - CALL SGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -613,10 +613,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -645,9 +645,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYROW.EQ.ICROW2 ) THEN - * -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -668,13 +668,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ ICCOL2 ) - * - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL SAXPY( MPC2, -TAULOC, WORK, 1, -+ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK, 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * - IF( MPC2.GT.0 .AND. NQV.GT.0 ) -- $ CALL SGER( MPC2, NQV, -TAULOC, WORK, 1, -+ $ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC2 ), - $ LDC ) - END IF -@@ -698,9 +698,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = NQV+1 - CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -719,13 +719,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), - $ RDEST, ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -- $ C( IOFFC1 ), 1 ) -+ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -750,7 +750,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -759,7 +759,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -778,12 +778,12 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -+ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, - $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -808,18 +808,18 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( IIV ) - CALL SGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * - IPW = NQV+1 - CALL SGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -839,13 +839,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -864,7 +864,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -873,7 +873,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -892,13 +892,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -diff --git a/SRC/pslawil.f b/SRC/pslawil.f -index e04c16b..671e08e 100644 ---- a/SRC/pslawil.f -+++ b/SRC/pslawil.f -@@ -120,10 +120,14 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - INTEGER CONTXT, DOWN, HBL, ICOL, IROW, JSRC, LDA, LEFT, - $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT, - $ RSRC, UP -- REAL H11, H12, H21, H22, H33S, H44S, S, V1, V2, V3 -+ REAL H22, H33S, H44S, S, V1, V2 - * .. - * .. Local Arrays .. - REAL BUF( 4 ) -+ REAL H11( 1 ) -+ REAL H12( 1 ) -+ REAL H21( 1 ) -+ REAL V3( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, SGERV2D, SGESD2D, INFOG2L -@@ -170,18 +174,18 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( NPCOL.GT.1 ) THEN - CALL SGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT ) - ELSE -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - IF( NUM.GT.1 ) THEN - CALL SGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT ) -- H11 = BUF( 1 ) -- H21 = BUF( 2 ) -- H12 = BUF( 3 ) -+ H11( 1 ) = BUF( 1 ) -+ H21( 1 ) = BUF( 2 ) -+ H12( 1 ) = BUF( 3 ) - H22 = BUF( 4 ) - ELSE -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) - END IF - END IF -@@ -214,20 +218,20 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( NUM.GT.1 ) THEN - CALL SGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT ) - ELSE -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) - END IF - IF( NPROW.GT.1 ) THEN - CALL SGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL ) - ELSE -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - END IF - IF( NPCOL.GT.1 ) THEN - CALL SGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT ) - ELSE -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) - END IF - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - END IF - IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) -@@ -236,24 +240,24 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( MODKM1.GT.1 ) THEN - CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, - $ IROW, ICOL, RSRC, JSRC ) -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - * -- H44S = H44 - H11 -- H33S = H33 - H11 -- V1 = ( H33S*H44S-H43H34 ) / H21 + H12 -- V2 = H22 - H11 - H33S - H44S -- S = ABS( V1 ) + ABS( V2 ) + ABS( V3 ) -+ H44S = H44 - H11( 1 ) -+ H33S = H33 - H11( 1 ) -+ V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 ) -+ V2 = H22 - H11( 1 ) - H33S - H44S -+ S = ABS( V1 ) + ABS( V2 ) + ABS( V3( 1 ) ) - V1 = V1 / S - V2 = V2 / S -- V3 = V3 / S -+ V3( 1 ) = V3( 1 ) / S - V( 1 ) = V1 - V( 2 ) = V2 -- V( 3 ) = V3 -+ V( 3 ) = V3( 1 ) - * - RETURN - * -diff --git a/SRC/psstebz.f b/SRC/psstebz.f -index a8a2496..7e588a9 100644 ---- a/SRC/psstebz.f -+++ b/SRC/psstebz.f -@@ -244,14 +244,14 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, - $ ITMP2, J, JB, K, LAST, LEXTRA, LREQ, MYCOL, - $ MYROW, NALPHA, NBETA, NCMP, NEIGINT, NEXT, NGL, - $ NGLOB, NGU, NINT, NPCOL, NPROW, OFFSET, -- $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF, -- $ TORECV -+ $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF - REAL ALPHA, ATOLI, BETA, BNORM, DRECV, DSEND, GL, - $ GU, INITVL, INITVU, LSAVE, MID, PIVMIN, RELTOL, - $ SAFEMN, TMP1, TMP2, TNORM, ULP - * .. - * .. Local Arrays .. - INTEGER IDUM( 5, 2 ) -+ INTEGER TORECV( 1, 1 ) - * .. - * .. Executable Statements .. - * This is just to keep ftnchek happy -@@ -774,14 +774,14 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, - ELSE - CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', 1, 1, TORECV, 1, 0, - $ I-1 ) -- IF( TORECV.NE.0 ) THEN -- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, IWORK, -- $ TORECV, 0, I-1 ) -- CALL SGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, WORK, -- $ TORECV, 0, I-1 ) -- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, -- $ IWORK( N+1 ), TORECV, 0, I-1 ) -- DO 120 J = 1, TORECV -+ IF( TORECV( 1, 1 ).NE.0 ) THEN -+ CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, -+ $ IWORK, TORECV( 1, 1 ), 0, I-1 ) -+ CALL SGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, -+ $ WORK, TORECV( 1, 1 ), 0, I-1 ) -+ CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, -+ $ IWORK( N+1 ), TORECV( 1, 1 ), 0, I-1 ) -+ DO 120 J = 1, TORECV( 1, 1 ) - W( IWORK( J ) ) = WORK( J ) - IBLOCK( IWORK( J ) ) = IWORK( N+J ) - 120 CONTINUE -diff --git a/SRC/pstrord.f b/SRC/pstrord.f -index 3562242..5cdb549 100644 ---- a/SRC/pstrord.f -+++ b/SRC/pstrord.f -@@ -328,12 +328,13 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - $ EAST, WEST, ILOC4, SOUTH, NORTH, INDXS, - $ ITT, JTT, ILEN, DLEN, INDXE, TRSRC1, TCSRC1, - $ TRSRC2, TCSRC2, ILOS, DIR, TLIHI, TLILO, TLSEL, -- $ ROUND, LAST, WIN0S, WIN0E, WINE, MMAX, MMIN -+ $ ROUND, LAST, WIN0S, WIN0E, WINE - REAL ELEM, ELEM1, ELEM2, ELEM3, ELEM4, SN, CS, TMP, - $ ELEM5 - * .. - * .. Local Arrays .. -- INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ) -+ INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ), MMAX( 1 ), -+ $ MMIN( 1 ), INFODUM( 1 ) - * .. - * .. External Functions .. - LOGICAL LSAME -@@ -483,16 +484,16 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - END IF - IF( SELECT(K).NE.0 ) M = M + 1 - 10 CONTINUE -- MMAX = M -- MMIN = M -+ MMAX( 1 ) = M -+ MMIN( 1 ) = M - IF( NPROCS.GT.1 ) - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1, - $ -1, -1, -1, -1 ) - IF( NPROCS.GT.1 ) - $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1, - $ -1, -1, -1, -1 ) -- IF( MMAX.GT.MMIN ) THEN -- M = MMAX -+ IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN -+ M = MMAX( 1 ) - IF( NPROCS.GT.1 ) - $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, SELECT, N, - $ -1, -1, -1, -1, -1 ) -@@ -520,9 +521,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * - * Global maximum on info. - * -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1, -- $ -1, -1 ) -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, -+ $ -1, -1, -1 ) -+ INFO = INFODUM( 1 ) -+ END IF - * - * Return if some argument is incorrect. - * -@@ -1576,9 +1579,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * experienced a failure in the reordering. - * - MYIERR = IERR -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, - $ -1, -1, -1, -1 ) -+ IERR = INFODUM( 1 ) -+ END IF - * - IF( IERR.NE.0 ) THEN - * -@@ -1586,9 +1591,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * to swap. - * - IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1) -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, - $ -1, -1, -1, -1 ) -+ INFO = INFODUM( 1 ) -+ END IF - GO TO 300 - END IF - * -@@ -3245,9 +3252,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * experienced a failure in the reordering. - * - MYIERR = IERR -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, - $ -1, -1, -1, -1 ) -+ IERR = INFODUM( 1 ) -+ END IF - * - IF( IERR.NE.0 ) THEN - * -@@ -3255,9 +3264,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, - * to swap. - * - IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1) -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, - $ -1, -1, -1, -1 ) -+ INFO = INFODUM( 1 ) -+ END IF - GO TO 300 - END IF - * -diff --git a/SRC/pstrsen.f b/SRC/pstrsen.f -index 6219bdb..1922e8f 100644 ---- a/SRC/pstrsen.f -+++ b/SRC/pstrsen.f -@@ -354,13 +354,15 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, - LOGICAL LQUERY, WANTBH, WANTQ, WANTS, WANTSP - INTEGER ICOFFT12, ICTXT, IDUM1, IDUM2, IERR, ILOC1, - $ IPW1, ITER, ITT, JLOC1, JTT, K, LIWMIN, LLDT, -- $ LLDQ, LWMIN, MMAX, MMIN, MYROW, MYCOL, N1, N2, -+ $ LLDQ, LWMIN, MYROW, MYCOL, N1, N2, - $ NB, NOEXSY, NPCOL, NPROCS, NPROW, SPACE, - $ T12ROWS, T12COLS, TCOLS, TCSRC, TROWS, TRSRC, - $ WRK1, IWRK1, WRK2, IWRK2, WRK3, IWRK3 -- REAL DPDUM1, ELEM, EST, SCALE, RNORM -+ REAL ELEM, EST, SCALE, RNORM - * .. Local Arrays .. -- INTEGER DESCT12( DLEN_ ), MBNB2( 2 ) -+ INTEGER DESCT12( DLEN_ ), MBNB2( 2 ), MMAX( 1 ), -+ $ MMIN( 1 ), INFODUM( 1 ) -+ REAL DPDUM1( 1 ) - * .. - * .. External Functions .. - LOGICAL LSAME -@@ -521,16 +523,16 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, - END IF - IF( SELECT(K) ) M = M + 1 - 10 CONTINUE -- MMAX = M -- MMIN = M -+ MMAX( 1 ) = M -+ MMIN( 1 ) = M - IF( NPROCS.GT.1 ) - $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1, - $ -1, -1, -1, -1 ) - IF( NPROCS.GT.1 ) - $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1, - $ -1, -1, -1, -1 ) -- IF( MMAX.GT.MMIN ) THEN -- M = MMAX -+ IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN -+ M = MMAX( 1 ) - IF( NPROCS.GT.1 ) - $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, IWORK, N, - $ -1, -1, -1, -1, -1 ) -@@ -602,9 +604,11 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, - * - * Global maximum on info - * -- IF( NPROCS.GT.1 ) -- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1, -+ IF( NPROCS.GT.1 ) THEN -+ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, -1, - $ -1, -1 ) -+ INFO = INFODUM( 1 ) -+ END IF - * - * Return if some argument is incorrect - * -diff --git a/SRC/pzlarf.f b/SRC/pzlarf.f -index df65912..7bff287 100644 ---- a/SRC/pzlarf.f -+++ b/SRC/pzlarf.f -@@ -242,7 +242,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, - $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, - $ NQ, RDEST -- COMPLEX*16 TAULOC -+ COMPLEX*16 TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV, -@@ -336,7 +336,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -345,7 +345,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -363,8 +363,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -379,9 +379,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYCOL.EQ.ICCOL ) THEN - * -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -398,7 +398,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL ZGERC( MP, NQ, -TAULOC, V( IOFFV ), 1, -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, - $ WORK, 1, C( IOFFC ), LDC ) - END IF - * -@@ -421,9 +421,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = MP+1 - CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -441,7 +441,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * -@@ -471,7 +471,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -480,7 +480,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -500,8 +500,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - v * w' - * - IF( IOFFC.GT.0 ) -- $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -516,18 +516,18 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( JJV ) - CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * - IPW = MP+1 - CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -547,8 +547,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - v * w' - * - IF( IOFFC.GT.0 ) -- $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -577,9 +577,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYROW.EQ.ICROW ) THEN - * -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -597,7 +597,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - w * v' - * - IF( IOFFV.GT.0 .AND. IOFFC.GT.0 ) -- $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, -+ $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC ), - $ LDC ) - END IF -@@ -621,9 +621,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = NQ+1 - CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -641,8 +641,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -667,7 +667,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -676,7 +676,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -694,8 +694,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -720,18 +720,18 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( IIV ) - CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * - IPW = NQ+1 - CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -750,8 +750,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * sub( C ) := sub( C ) - w * v' - * - IF( IOFFC.GT.0 ) -- $ CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -770,7 +770,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -779,7 +779,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -797,8 +797,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, -- $ C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -diff --git a/SRC/pzlarfc.f b/SRC/pzlarfc.f -index eb469fc..ddd7ec6 100644 ---- a/SRC/pzlarfc.f -+++ b/SRC/pzlarfc.f -@@ -242,7 +242,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, - $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, - $ NQ, RDEST -- COMPLEX*16 TAULOC -+ COMPLEX*16 TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV, -@@ -336,17 +336,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = DCONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) - * - ELSE - * - CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAULOC, 1, IVROW, MYCOL ) -- TAULOC = DCONJG( TAULOC ) -+ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -364,8 +364,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -380,9 +380,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYCOL.EQ.ICCOL ) THEN - * -- TAULOC = DCONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -399,7 +399,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL ZGERC( MP, NQ, -TAULOC, V( IOFFV ), 1, -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, - $ WORK, 1, C( IOFFC ), LDC ) - END IF - * -@@ -422,9 +422,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = MP+1 - CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = DCONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -442,7 +442,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * -@@ -472,17 +472,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = DCONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) - * - ELSE - * - CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, - $ 1, IVROW, MYCOL ) -- TAULOC = DCONJG( TAULOC ) -+ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -500,8 +500,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1, -- $ C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -516,18 +516,18 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( JJV ) - CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = DCONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) - * - ELSE - * - IPW = MP+1 - CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = DCONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -545,8 +545,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - v * w' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1, -- $ C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -575,9 +575,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - IF( MYROW.EQ.ICROW ) THEN - * -- TAULOC = DCONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -594,7 +594,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC ), LDC ) - END IF - * -@@ -617,9 +617,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - IPW = NQ+1 - CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = DCONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -637,8 +637,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -663,17 +663,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = DCONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) - * - ELSE - * - CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, - $ 1, MYROW, IVCOL ) -- TAULOC = DCONJG( TAULOC ) -+ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -691,8 +691,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -@@ -716,18 +716,18 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - WORK(IPW) = TAU( IIV ) - CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = DCONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) - * - ELSE - * - IPW = NQ+1 - CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = DCONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -745,8 +745,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, -- $ C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - ELSE -@@ -765,17 +765,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = DCONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) - * - ELSE - * - CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1, - $ MYROW, IVCOL ) -- TAULOC = DCONJG( TAULOC ) -+ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -793,8 +793,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, -- $ C( IOFFC ), LDC ) -+ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC ), LDC ) - END IF - * - END IF -diff --git a/SRC/pzlarz.f b/SRC/pzlarz.f -index fefc133..abf6288 100644 ---- a/SRC/pzlarz.f -+++ b/SRC/pzlarz.f -@@ -251,7 +251,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, - $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, - $ NQC2, NQV, RDEST -- COMPLEX*16 TAULOC -+ COMPLEX*16 TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV, -@@ -370,7 +370,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -379,7 +379,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -402,9 +402,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -420,9 +420,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYCOL.EQ.ICCOL2 ) THEN - * -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -445,11 +445,11 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK, -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK, - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -471,9 +471,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = MPV+1 - CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -496,10 +496,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -530,7 +530,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * -@@ -539,7 +539,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -562,10 +562,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -580,18 +580,18 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( JJV ) - CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * - IPW = MPV+1 - CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -614,10 +614,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -646,9 +646,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYROW.EQ.ICROW2 ) THEN - * -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -669,13 +669,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ ICCOL2 ) - * - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK, 1, -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK, 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * - IF( MPC2.GT.0 .AND. NQV.GT.0 ) -- $ CALL ZGERC( MPC2, NQV, -TAULOC, WORK, 1, -+ $ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC2 ), - $ LDC ) - END IF -@@ -699,9 +699,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = NQV+1 - CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -720,13 +720,14 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), - $ RDEST, ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -- $ C( IOFFC1 ), 1 ) -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), -+ $ WORK( IPW ), 1, WORK, 1, -+ $ C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -751,7 +752,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -760,7 +761,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -779,13 +780,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -809,18 +810,18 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( IIV ) - CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = TAU( IIV ) -+ TAULOC( 1 ) = TAU( IIV ) - * - ELSE - * - IPW = NQV+1 - CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = WORK( IPW ) -+ TAULOC( 1 ) = WORK( IPW ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -840,13 +841,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -865,7 +866,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = TAU( JJV ) -+ TAULOC( 1 ) = TAU( JJV ) - * - ELSE - * -@@ -874,7 +875,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -893,13 +894,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -diff --git a/SRC/pzlarzc.f b/SRC/pzlarzc.f -index 936caec..2c574ff 100644 ---- a/SRC/pzlarzc.f -+++ b/SRC/pzlarzc.f -@@ -251,7 +251,7 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, - $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, - $ NQC2, NQV, RDEST -- COMPLEX*16 TAULOC -+ COMPLEX*16 TAULOC( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV, -@@ -370,17 +370,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = DCONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) - * - ELSE - * - CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAULOC, 1, IVROW, MYCOL ) -- TAULOC = DCONJG( TAULOC ) -+ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -403,9 +403,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -421,9 +421,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYCOL.EQ.ICCOL2 ) THEN - * -- TAULOC = DCONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -446,11 +446,11 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK, -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK, - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -472,9 +472,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = MPV+1 - CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, - $ IVCOL ) -- TAULOC = DCONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -497,10 +497,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), - $ LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, - $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * -@@ -531,17 +531,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, - $ TAU( IIV ), 1 ) -- TAULOC = DCONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) - * - ELSE - * - CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, - $ 1, IVROW, MYCOL ) -- TAULOC = DCONJG( TAULOC ) -+ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -564,10 +564,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -582,18 +582,18 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( JJV ) - CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = DCONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) - * - ELSE - * - IPW = MPV+1 - CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, - $ IPW, MYROW, IVCOL ) -- TAULOC = DCONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C )' * v - * -@@ -616,10 +616,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * sub( C ) := sub( C ) - v * w' - * - IF( MYROW.EQ.ICROW1 ) -- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), -+ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), - $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) -- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), -- $ 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, -+ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -648,9 +648,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - IF( MYROW.EQ.ICROW2 ) THEN - * -- TAULOC = DCONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -671,12 +671,12 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ ICCOL2 ) - * - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK, 1, -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK, 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MPC2, NQV, -TAULOC, WORK, 1, -+ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1, - $ V( IOFFV ), LDV, C( IOFFC2 ), LDC ) - END IF - * -@@ -699,9 +699,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - IPW = NQV+1 - CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, - $ MYCOL ) -- TAULOC = DCONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -720,13 +720,14 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), - $ RDEST, ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -- $ C( IOFFC1 ), 1 ) -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), -+ $ WORK( IPW ), 1, WORK, 1, -+ $ C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -751,17 +752,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, - $ TAU( JJV ), 1 ) -- TAULOC = DCONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) - * - ELSE - * - CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, - $ 1, MYROW, IVCOL ) -- TAULOC = DCONJG( TAULOC ) -+ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -780,13 +781,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, -- $ WORK, 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), -+ $ 1, WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -@@ -810,18 +811,18 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - WORK( IPW ) = TAU( IIV ) - CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW ) -- TAULOC = DCONJG( TAU( IIV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) - * - ELSE - * - IPW = NQV+1 - CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, - $ WORK, IPW, IVROW, MYCOL ) -- TAULOC = DCONJG( WORK( IPW ) ) -+ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -841,13 +842,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - ELSE -@@ -866,17 +867,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - * - CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), - $ 1 ) -- TAULOC = DCONJG( TAU( JJV ) ) -+ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) - * - ELSE - * - CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1, - $ MYROW, IVCOL ) -- TAULOC = DCONJG( TAULOC ) -+ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) - * - END IF - * -- IF( TAULOC.NE.ZERO ) THEN -+ IF( TAULOC( 1 ).NE.ZERO ) THEN - * - * w := sub( C ) * v - * -@@ -895,13 +896,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, - $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, - $ ICCOL2 ) - IF( MYCOL.EQ.ICCOL1 ) -- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, -+ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, - $ C( IOFFC1 ), 1 ) - * - * sub( C ) := sub( C ) - w * v' - * -- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, -- $ 1, C( IOFFC2 ), LDC ) -+ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, -+ $ WORK, 1, C( IOFFC2 ), LDC ) - END IF - * - END IF -diff --git a/SRC/pzlattrs.f b/SRC/pzlattrs.f -index 819e476..5a54209 100644 ---- a/SRC/pzlattrs.f -+++ b/SRC/pzlattrs.f -@@ -271,8 +271,9 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - $ JINC, JLAST, LDA, LDX, MB, MYCOL, MYROW, NB, - $ NPCOL, NPROW, RSRC - DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL, -- $ XBND, XJ, XMAX -+ $ XBND, XJ - COMPLEX*16 CSUMJ, TJJS, USCAL, XJTMP, ZDUM -+ DOUBLE PRECISION XMAX( 1 ) - * .. - * .. External Functions .. - LOGICAL LSAME -@@ -391,11 +392,11 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - * Compute a bound on the computed solution vector to see if the - * Level 2 PBLAS routine PZTRSV can be used. - * -- XMAX = ZERO -+ XMAX( 1 ) = ZERO - CALL PZAMAX( N, ZDUM, IMAX, X, IX, JX, DESCX, 1 ) -- XMAX = CABS2( ZDUM ) -+ XMAX( 1 ) = CABS2( ZDUM ) - CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, -1, -1 ) -- XBND = XMAX -+ XBND = XMAX( 1 ) - * - IF( NOTRAN ) THEN - * -@@ -590,16 +591,16 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - * - * Use a Level 1 PBLAS solve, scaling intermediate results. - * -- IF( XMAX.GT.BIGNUM*HALF ) THEN -+ IF( XMAX( 1 ).GT.BIGNUM*HALF ) THEN - * - * Scale X so that its components are less than or equal to - * BIGNUM in absolute value. - * -- SCALE = ( BIGNUM*HALF ) / XMAX -+ SCALE = ( BIGNUM*HALF ) / XMAX( 1 ) - CALL PZDSCAL( N, SCALE, X, IX, JX, DESCX, 1 ) -- XMAX = BIGNUM -+ XMAX( 1 ) = BIGNUM - ELSE -- XMAX = XMAX*TWO -+ XMAX( 1 ) = XMAX( 1 )*TWO - END IF - * - IF( NOTRAN ) THEN -@@ -651,7 +652,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * X( J ) = ZLADIV( X( J ), TJJS ) -@@ -682,7 +683,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - * X( J ) = ZLADIV( X( J ), TJJS ) - * XJ = CABS1( X( J ) ) -@@ -706,7 +707,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - XJTMP = CONE - XJ = ONE - SCALE = ZERO -- XMAX = ZERO -+ XMAX( 1 ) = ZERO - END IF - 90 CONTINUE - * -@@ -715,7 +716,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - * - IF( XJ.GT.ONE ) THEN - REC = ONE / XJ -- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN -+ IF( CNORM( J ).GT.( BIGNUM-XMAX( 1 ) )*REC ) THEN - * - * Scale x by 1/(2*abs(x(j))). - * -@@ -724,7 +725,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - XJTMP = XJTMP*REC - SCALE = SCALE*REC - END IF -- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN -+ ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX( 1 ) ) ) THEN - * - * Scale x by 1/2. - * -@@ -743,7 +744,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZAXPY( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1, X, - $ IX, JX, DESCX, 1 ) - CALL PZAMAX( J-1, ZDUM, IMAX, X, IX, JX, DESCX, 1 ) -- XMAX = CABS1( ZDUM ) -+ XMAX( 1 ) = CABS1( ZDUM ) - CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, - $ -1, -1 ) - END IF -@@ -757,7 +758,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZAXPY( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1, - $ X, IX+J, JX, DESCX, 1 ) - CALL PZAMAX( N-J, ZDUM, I, X, IX+J, JX, DESCX, 1 ) -- XMAX = CABS1( ZDUM ) -+ XMAX( 1 ) = CABS1( ZDUM ) - CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, - $ -1, -1 ) - END IF -@@ -785,7 +786,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - END IF - XJ = CABS1( XJTMP ) - USCAL = DCMPLX( TSCAL ) -- REC = ONE / MAX( XMAX, ONE ) -+ REC = ONE / MAX( XMAX( 1 ), ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN - * - * If x(j) could overflow, scale x by 1/(2*XMAX). -@@ -820,7 +821,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * -@@ -924,7 +925,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * X( J ) = ZLADIV( X( J ), TJJS ) -@@ -945,7 +946,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - * X( J ) = ZLADIV( X( J ), TJJS ) - XJTMP = ZLADIV( XJTMP, TJJS ) -@@ -966,7 +967,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - END IF - XJTMP = CONE - SCALE = ZERO -- XMAX = ZERO -+ XMAX( 1 ) = ZERO - END IF - 110 CONTINUE - ELSE -@@ -981,7 +982,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - X( IROWX ) = XJTMP - END IF - END IF -- XMAX = MAX( XMAX, CABS1( XJTMP ) ) -+ XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) ) - 120 CONTINUE - * - ELSE -@@ -1004,7 +1005,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - END IF - XJ = CABS1( XJTMP ) - USCAL = TSCAL -- REC = ONE / MAX( XMAX, ONE ) -+ REC = ONE / MAX( XMAX( 1 ), ONE ) - IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN - * - * If x(j) could overflow, scale x by 1/(2*XMAX). -@@ -1039,7 +1040,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * -@@ -1145,7 +1146,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - END IF - * X( J ) = ZLADIV( X( J ), TJJS ) -@@ -1164,7 +1165,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) - XJTMP = XJTMP*REC - SCALE = SCALE*REC -- XMAX = XMAX*REC -+ XMAX( 1 ) = XMAX( 1 )*REC - END IF - * X( J ) = ZLADIV( X( J ), TJJS ) - XJTMP = ZLADIV( XJTMP, TJJS ) -@@ -1181,7 +1182,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - $ X( IROWX ) = CONE - XJTMP = CONE - SCALE = ZERO -- XMAX = ZERO -+ XMAX( 1 ) = ZERO - END IF - 130 CONTINUE - ELSE -@@ -1194,7 +1195,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, - IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) ) - $ X( IROWX ) = XJTMP - END IF -- XMAX = MAX( XMAX, CABS1( XJTMP ) ) -+ XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) ) - 140 CONTINUE - END IF - SCALE = SCALE / TSCAL -diff --git a/SRC/pzlawil.f b/SRC/pzlawil.f -index e89a9a3..7e502ef 100644 ---- a/SRC/pzlawil.f -+++ b/SRC/pzlawil.f -@@ -124,11 +124,10 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT, - $ RSRC, UP - DOUBLE PRECISION S -- COMPLEX*16 CDUM, H11, H12, H21, H22, H33S, H44S, V1, V2, -- $ V3 -+ COMPLEX*16 CDUM, H22, H33S, H44S, V1, V2 - * .. - * .. Local Arrays .. -- COMPLEX*16 BUF( 4 ) -+ COMPLEX*16 BUF( 4 ), H11( 1 ), H12( 1 ), H21( 1 ), V3( 1 ) - * .. - * .. External Subroutines .. - EXTERNAL BLACS_GRIDINFO, INFOG2L, ZGERV2D, ZGESD2D -@@ -181,18 +180,18 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( NPCOL.GT.1 ) THEN - CALL ZGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT ) - ELSE -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - IF( NUM.GT.1 ) THEN - CALL ZGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT ) -- H11 = BUF( 1 ) -- H21 = BUF( 2 ) -- H12 = BUF( 3 ) -+ H11( 1 ) = BUF( 1 ) -+ H21( 1 ) = BUF( 2 ) -+ H12( 1 ) = BUF( 3 ) - H22 = BUF( 4 ) - ELSE -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) - END IF - END IF -@@ -225,20 +224,20 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( NUM.GT.1 ) THEN - CALL ZGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT ) - ELSE -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) - END IF - IF( NPROW.GT.1 ) THEN - CALL ZGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL ) - ELSE -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - END IF - IF( NPCOL.GT.1 ) THEN - CALL ZGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT ) - ELSE -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) - END IF - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - END IF - IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) -@@ -247,24 +246,24 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) - IF( MODKM1.GT.1 ) THEN - CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, - $ IROW, ICOL, RSRC, JSRC ) -- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) -- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) -- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) -+ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) -+ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) -+ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) - H22 = A( ( ICOL-2 )*LDA+IROW-1 ) -- V3 = A( ( ICOL-2 )*LDA+IROW ) -+ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) - END IF - * -- H44S = H44 - H11 -- H33S = H33 - H11 -- V1 = ( H33S*H44S-H43H34 ) / H21 + H12 -- V2 = H22 - H11 - H33S - H44S -- S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3 ) -+ H44S = H44 - H11( 1 ) -+ H33S = H33 - H11( 1 ) -+ V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 ) -+ V2 = H22 - H11( 1 ) - H33S - H44S -+ S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3( 1 ) ) - V1 = V1 / S - V2 = V2 / S -- V3 = V3 / S -+ V3( 1 ) = V3( 1 ) / S - V( 1 ) = V1 - V( 2 ) = V2 -- V( 3 ) = V3 -+ V( 3 ) = V3( 1 ) - * - RETURN - * -diff --git a/SRC/pztrevc.f b/SRC/pztrevc.f -index 0536475..3b27286 100644 ---- a/SRC/pztrevc.f -+++ b/SRC/pztrevc.f -@@ -218,11 +218,12 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - $ ITMP2, J, K, KI, LDT, LDVL, LDVR, LDW, MB, - $ MYCOL, MYROW, NB, NPCOL, NPROW, RSRC - REAL SELF -- DOUBLE PRECISION OVFL, REMAXD, SCALE, SMIN, SMLNUM, ULP, UNFL -+ DOUBLE PRECISION OVFL, REMAXD, SCALE, SMLNUM, ULP, UNFL - COMPLEX*16 CDUM, REMAXC, SHIFT - * .. - * .. Local Arrays .. - INTEGER DESCW( DLEN_ ) -+ DOUBLE PRECISION SMIN( 1 ) - * .. - * .. External Functions .. - LOGICAL LSAME -@@ -355,13 +356,13 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - $ GO TO 70 - END IF - * -- SMIN = ZERO -+ SMIN( 1 ) = ZERO - SHIFT = CZERO - CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL, - $ IROW, ICOL, ITMP1, ITMP2 ) - IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN - SHIFT = T( ( ICOL-1 )*LDT+IROW ) -- SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) -+ SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) - END IF - CALL DGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 ) - CALL ZGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 ) -@@ -396,8 +397,9 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN - T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) - - $ SHIFT -- IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) THEN -- T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN ) -+ IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) ) -+ $ THEN -+ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN( 1 ) ) - END IF - END IF - 50 CONTINUE -@@ -467,13 +469,13 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - $ GO TO 110 - END IF - * -- SMIN = ZERO -+ SMIN( 1 ) = ZERO - SHIFT = CZERO - CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL, - $ IROW, ICOL, ITMP1, ITMP2 ) - IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN - SHIFT = T( ( ICOL-1 )*LDT+IROW ) -- SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) -+ SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) - END IF - CALL DGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 ) - CALL ZGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 ) -@@ -507,8 +509,8 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, - IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN - T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) - - $ SHIFT -- IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) -- $ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN ) -+ IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) ) -+ $ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN( 1 ) ) - END IF - 90 CONTINUE - * - -From 189c84001bcd564296a475c5c757afc9f337e828 Mon Sep 17 00:00:00 2001 -From: =?UTF-8?q?Tiziano=20M=C3=BCller?= -Date: Thu, 25 Jun 2020 18:37:34 +0200 -Subject: [PATCH] use -std=legacy for tests with GCC-10+ - ---- - BLACS/TESTING/CMakeLists.txt | 10 +++++++--- - PBLAS/TESTING/CMakeLists.txt | 7 ++++--- - PBLAS/TIMING/CMakeLists.txt | 5 +++-- - TESTING/EIG/CMakeLists.txt | 3 +++ - TESTING/LIN/CMakeLists.txt | 4 ++++ - 5 files changed, 21 insertions(+), 8 deletions(-) - -diff --git a/BLACS/TESTING/CMakeLists.txt b/BLACS/TESTING/CMakeLists.txt -index d8846b5..4e91ac2 100644 ---- a/BLACS/TESTING/CMakeLists.txt -+++ b/BLACS/TESTING/CMakeLists.txt -@@ -1,10 +1,14 @@ --set(FTestObj -+set(FTestObj - blacstest.f btprim.f tools.f) - -+if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) -+ set_source_files_properties(blacstest.f PROPERTIES COMPILE_FLAGS "-std=legacy") -+endif() -+ - add_executable(xFbtest ${FTestObj}) - target_link_libraries(xFbtest scalapack) - --set(CTestObj -+set(CTestObj - Cbt.c) - - set_property( -@@ -46,4 +50,4 @@ add_test(xFbtest - -DRUNTIMEDIR=${CMAKE_RUNTIME_OUTPUT_DIRECTORY} - -DSOURCEDIR=${CMAKE_CURRENT_SOURCE_DIR} - -P ${CMAKE_CURRENT_SOURCE_DIR}/runtest.cmake -- ) -\ No newline at end of file -+ ) -diff --git a/PBLAS/TESTING/CMakeLists.txt b/PBLAS/TESTING/CMakeLists.txt -index e60f5e4..ee77091 100644 ---- a/PBLAS/TESTING/CMakeLists.txt -+++ b/PBLAS/TESTING/CMakeLists.txt -@@ -10,7 +10,7 @@ set (zpbtcom pzblastst.f dlamch.f ${pbtcom}) - - set_property( - SOURCE ${PblasErrorHandler} -- APPEND PROPERTY COMPILE_DEFINITIONS TestingPblas -+ APPEND PROPERTY COMPILE_DEFINITIONS TestingPblas - ) - - set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${SCALAPACK_BINARY_DIR}/PBLAS/TESTING) -@@ -74,5 +74,6 @@ add_test(dpb3tst ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./dpb3tst) - add_test(cpb3tst ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./cpb3tst) - add_test(zpb3tst ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./zpb3tst) - -- -- -+if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) -+ set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory -+endif() -diff --git a/PBLAS/TIMING/CMakeLists.txt b/PBLAS/TIMING/CMakeLists.txt -index 763330f..208bbc3 100644 ---- a/PBLAS/TIMING/CMakeLists.txt -+++ b/PBLAS/TIMING/CMakeLists.txt -@@ -74,5 +74,6 @@ add_test(dpb3tim ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./dpb3tim) - add_test(cpb3tim ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./cpb3tim) - add_test(zpb3tim ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ./zpb3tim) - -- -- -+if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) -+ set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory -+endif() -diff --git a/TESTING/EIG/CMakeLists.txt b/TESTING/EIG/CMakeLists.txt -index 97c7036..19a1f34 100644 ---- a/TESTING/EIG/CMakeLists.txt -+++ b/TESTING/EIG/CMakeLists.txt -@@ -97,3 +97,6 @@ target_link_libraries(xzheevr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xshseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdhseqr scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - -+if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) -+ set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory -+endif() -diff --git a/TESTING/LIN/CMakeLists.txt b/TESTING/LIN/CMakeLists.txt -index 55a53e9..65f169b 100644 ---- a/TESTING/LIN/CMakeLists.txt -+++ b/TESTING/LIN/CMakeLists.txt -@@ -110,3 +110,7 @@ target_link_libraries(xsls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xdls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xcls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) - target_link_libraries(xzls scalapack ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) -+ -+if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) -+ set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -std=legacy" ) # local to this directory -+endif()