diff options
| -rw-r--r-- | gnu/local.mk | 2 | ||||
| -rw-r--r-- | gnu/packages/maths.scm | 16 | ||||
| -rw-r--r-- | gnu/packages/patches/scalapack-blacs-mpi-deprecations.patch | 170 | ||||
| -rw-r--r-- | gnu/packages/patches/scalapack-gcc-10-compilation.patch | 5684 |
4 files changed, 5697 insertions, 175 deletions
diff --git a/gnu/local.mk b/gnu/local.mk index 2fc05ba703..8b9597bfe1 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1750,7 +1750,7 @@ dist_patch_DATA = \ %D%/packages/patches/sbcl-burgled-batteries3-fix-signals.patch \ %D%/packages/patches/sbcl-clml-fix-types.patch \ %D%/packages/patches/sbcl-png-fix-sbcl-compatibility.patch \ - %D%/packages/patches/scalapack-blacs-mpi-deprecations.patch \ + %D%/packages/patches/scalapack-gcc-10-compilation.patch \ %D%/packages/patches/scheme48-tests.patch \ %D%/packages/patches/scotch-build-parallelism.patch \ %D%/packages/patches/scotch-integer-declarations.patch \ diff --git a/gnu/packages/maths.scm b/gnu/packages/maths.scm index 38fea4c43b..5d56f00095 100644 --- a/gnu/packages/maths.scm +++ b/gnu/packages/maths.scm @@ -977,7 +977,7 @@ provide LAPACK for someone who does not have access to a Fortran compiler.") (define-public scalapack (package (name "scalapack") - (version "2.0.2") + (version "2.1.0") (source (origin (method url-fetch) @@ -985,8 +985,8 @@ provide LAPACK for someone who does not have access to a Fortran compiler.") version ".tgz")) (sha256 (base32 - "0p1r61ss1fq0bs8ynnx7xq4wwsdvs32ljvwjnx6yxr8gd6pawx0c")) - (patches (search-patches "scalapack-blacs-mpi-deprecations.patch")))) + "19i0h9vdc3zsy58r6fy1vs2kz2l7amifkz0cf926j90xz1n23nb1")) + (patches (search-patches "scalapack-gcc-10-compilation.patch")))) (build-system cmake-build-system) (inputs `(("mpi" ,openmpi) @@ -996,7 +996,15 @@ provide LAPACK for someone who does not have access to a Fortran compiler.") `(#:configure-flags `("-DBUILD_SHARED_LIBS:BOOL=YES") #:phases (modify-phases %standard-phases (add-before 'check 'mpi-setup - ,%openmpi-setup)))) + ,%openmpi-setup) + (add-after 'unpack 'skip-faulty-test + (lambda _ + ;; FIXME: Skip these two tests that fail to complete for + ;; unknown reasons: + ;; <https://github.com/Reference-ScaLAPACK/scalapack/issues/43>. + (substitute* "TESTING/CMakeLists.txt" + (("^add_test\\(x[sd]hseqr.*" all) + (string-append "# " all "\n")))))))) (home-page "http://www.netlib.org/scalapack/") (synopsis "Library for scalable numerical linear algebra") (description diff --git a/gnu/packages/patches/scalapack-blacs-mpi-deprecations.patch b/gnu/packages/patches/scalapack-blacs-mpi-deprecations.patch deleted file mode 100644 index 6ec1b8f21f..0000000000 --- a/gnu/packages/patches/scalapack-blacs-mpi-deprecations.patch +++ /dev/null @@ -1,170 +0,0 @@ -From f11c3f094ed5ca727ec819983425b6641db8227c Mon Sep 17 00:00:00 2001 -From: Eric Bavier <bavier@member.fsf.org> -Date: Wed, 13 Feb 2019 09:32:11 -0600 -Subject: [PATCH] BLACS: Remove use of long-deprecated MPI1 functions. - -* BLACS/SRC/blacs_get_.c: 'MPI_Attr_get' -> 'MPI_Comm_get_attr'. -* BLACS/SRC/cgamn2d_.c, BLACS/SRC/cgamx2d_.c, BLACS/SRC/dgamn2d_.c, -BLACS/SRC/dgamx2d_.c, BLACS/SRC/igamn2d_.c, BLACS/SRC/igamx2d_.c, -BLACS/SRC/sgamn2d_.c, BLACS/SRC/sgamx2d_.c, BLACS/SRC/zgamn2d_.c, -BLACS/SRC/zgamx2d_.c: 'MPI_Type_struct' -> 'MPI_Type_create_struct'. ---- - BLACS/SRC/blacs_get_.c | 2 +- - BLACS/SRC/cgamn2d_.c | 2 +- - BLACS/SRC/cgamx2d_.c | 2 +- - BLACS/SRC/dgamn2d_.c | 2 +- - BLACS/SRC/dgamx2d_.c | 2 +- - BLACS/SRC/igamn2d_.c | 2 +- - BLACS/SRC/igamx2d_.c | 2 +- - BLACS/SRC/sgamn2d_.c | 2 +- - BLACS/SRC/sgamx2d_.c | 2 +- - BLACS/SRC/zgamn2d_.c | 2 +- - BLACS/SRC/zgamx2d_.c | 2 +- - 11 files changed, 11 insertions(+), 11 deletions(-) - -diff --git a/BLACS/SRC/blacs_get_.c b/BLACS/SRC/blacs_get_.c -index e979767..d4b04cf 100644 ---- a/BLACS/SRC/blacs_get_.c -+++ b/BLACS/SRC/blacs_get_.c -@@ -23,7 +23,7 @@ F_VOID_FUNC blacs_get_(int *ConTxt, int *what, int *val) - case SGET_MSGIDS: - if (BI_COMM_WORLD == NULL) Cblacs_pinfo(val, &val[1]); - iptr = &val[1]; -- ierr=MPI_Attr_get(MPI_COMM_WORLD, MPI_TAG_UB, (BVOID **) &iptr,val); -+ ierr=MPI_Comm_get_attr(MPI_COMM_WORLD, MPI_TAG_UB, (BVOID **) &iptr,val); - val[0] = 0; - val[1] = *iptr; - break; -diff --git a/BLACS/SRC/cgamn2d_.c b/BLACS/SRC/cgamn2d_.c -index 2db6ccb..6958f32 100644 ---- a/BLACS/SRC/cgamn2d_.c -+++ b/BLACS/SRC/cgamn2d_.c -@@ -221,7 +221,7 @@ F_VOID_FUNC cgamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; -diff --git a/BLACS/SRC/cgamx2d_.c b/BLACS/SRC/cgamx2d_.c -index 707c0b6..f802d01 100644 ---- a/BLACS/SRC/cgamx2d_.c -+++ b/BLACS/SRC/cgamx2d_.c -@@ -221,7 +221,7 @@ F_VOID_FUNC cgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; -diff --git a/BLACS/SRC/dgamn2d_.c b/BLACS/SRC/dgamn2d_.c -index dff23b4..a2627ac 100644 ---- a/BLACS/SRC/dgamn2d_.c -+++ b/BLACS/SRC/dgamn2d_.c -@@ -221,7 +221,7 @@ F_VOID_FUNC dgamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; -diff --git a/BLACS/SRC/dgamx2d_.c b/BLACS/SRC/dgamx2d_.c -index a51f731..2a644d0 100644 ---- a/BLACS/SRC/dgamx2d_.c -+++ b/BLACS/SRC/dgamx2d_.c -@@ -221,7 +221,7 @@ F_VOID_FUNC dgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; -diff --git a/BLACS/SRC/igamn2d_.c b/BLACS/SRC/igamn2d_.c -index 16bc003..f6a7859 100644 ---- a/BLACS/SRC/igamn2d_.c -+++ b/BLACS/SRC/igamn2d_.c -@@ -218,7 +218,7 @@ F_VOID_FUNC igamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; -diff --git a/BLACS/SRC/igamx2d_.c b/BLACS/SRC/igamx2d_.c -index 8165cbe..a7cfcc6 100644 ---- a/BLACS/SRC/igamx2d_.c -+++ b/BLACS/SRC/igamx2d_.c -@@ -218,7 +218,7 @@ F_VOID_FUNC igamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; -diff --git a/BLACS/SRC/sgamn2d_.c b/BLACS/SRC/sgamn2d_.c -index d6c95e5..569c797 100644 ---- a/BLACS/SRC/sgamn2d_.c -+++ b/BLACS/SRC/sgamn2d_.c -@@ -221,7 +221,7 @@ F_VOID_FUNC sgamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; -diff --git a/BLACS/SRC/sgamx2d_.c b/BLACS/SRC/sgamx2d_.c -index 4b0af6f..8897ece 100644 ---- a/BLACS/SRC/sgamx2d_.c -+++ b/BLACS/SRC/sgamx2d_.c -@@ -221,7 +221,7 @@ F_VOID_FUNC sgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; -diff --git a/BLACS/SRC/zgamn2d_.c b/BLACS/SRC/zgamn2d_.c -index 9de2b23..37897df 100644 ---- a/BLACS/SRC/zgamn2d_.c -+++ b/BLACS/SRC/zgamn2d_.c -@@ -221,7 +221,7 @@ F_VOID_FUNC zgamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; -diff --git a/BLACS/SRC/zgamx2d_.c b/BLACS/SRC/zgamx2d_.c -index 414c381..0e9d474 100644 ---- a/BLACS/SRC/zgamx2d_.c -+++ b/BLACS/SRC/zgamx2d_.c -@@ -221,7 +221,7 @@ F_VOID_FUNC zgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, - { - #endif - i = 2; -- ierr=MPI_Type_struct(i, len, disp, dtypes, &MyType); -+ ierr=MPI_Type_create_struct(i, len, disp, dtypes, &MyType); - ierr=MPI_Type_commit(&MyType); - bp->N = bp2->N = 1; - bp->dtype = bp2->dtype = MyType; --- -2.20.1 - diff --git a/gnu/packages/patches/scalapack-gcc-10-compilation.patch b/gnu/packages/patches/scalapack-gcc-10-compilation.patch new file mode 100644 index 0000000000..cd6fb61cdf --- /dev/null +++ b/gnu/packages/patches/scalapack-gcc-10-compilation.patch @@ -0,0 +1,5684 @@ +Fix Scalapack compilation with GCC 10+. + +Patches from <https://github.com/Reference-ScaLAPACK/scalapack/pull/26>. + +From 9c909f06cf51a3d00252323ce52aba46cc64ab41 Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Tiziano=20M=C3=BCller?= <tiziano.mueller@chem.uzh.ch> +Date: Thu, 25 Jun 2020 18:36:46 +0200 +Subject: [PATCH] fix argument mismatches in the SRC + +--- + SRC/pclarf.f | 80 +++++++++++++++++----------------- + SRC/pclarfc.f | 88 ++++++++++++++++++------------------- + SRC/pclarz.f | 111 ++++++++++++++++++++++++----------------------- + SRC/pclarzc.f | 115 +++++++++++++++++++++++++------------------------ + SRC/pclattrs.f | 55 +++++++++++------------ + SRC/pclawil.f | 53 +++++++++++------------ + SRC/pctrevc.f | 20 +++++---- + SRC/pdhseqr.f | 36 ++++++++-------- + SRC/pdlacon.f | 36 ++++++++-------- + SRC/pdlarf.f | 80 +++++++++++++++++----------------- + SRC/pdlarz.f | 100 +++++++++++++++++++++--------------------- + SRC/pdlawil.f | 48 ++++++++++----------- + SRC/pdstebz.f | 20 ++++----- + SRC/pdtrord.f | 43 +++++++++++------- + SRC/pdtrsen.f | 24 ++++++----- + SRC/pshseqr.f | 36 ++++++++-------- + SRC/pslacon.f | 36 +++++++++------- + SRC/pslarf.f | 80 +++++++++++++++++----------------- + SRC/pslarz.f | 100 +++++++++++++++++++++--------------------- + SRC/pslawil.f | 50 +++++++++++---------- + SRC/psstebz.f | 20 ++++----- + SRC/pstrord.f | 45 +++++++++++-------- + SRC/pstrsen.f | 22 ++++++---- + SRC/pzlarf.f | 80 +++++++++++++++++----------------- + SRC/pzlarfc.f | 88 ++++++++++++++++++------------------- + SRC/pzlarz.f | 103 +++++++++++++++++++++---------------------- + SRC/pzlarzc.f | 111 ++++++++++++++++++++++++----------------------- + SRC/pzlattrs.f | 55 +++++++++++------------ + SRC/pzlawil.f | 49 +++++++++++---------- + SRC/pztrevc.f | 20 +++++---- + 30 files changed, 927 insertions(+), 877 deletions(-) + +diff --git a/SRC/pclarf.f b/SRC/pclarf.f +index f941e46..371f710 100644 +--- a/SRC/pclarf.f ++++ b/SRC/pclarf.f +@@ -242,7 +242,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, + $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, + $ NQ, RDEST +- COMPLEX TAULOC ++ COMPLEX TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, CCOPY, CGEBR2D, CGEBS2D, +@@ -336,7 +336,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -345,7 +345,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -363,8 +363,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -379,9 +379,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYCOL.EQ.ICCOL ) THEN + * +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -398,7 +398,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL CGERC( MP, NQ, -TAULOC, V( IOFFV ), 1, ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, + $ WORK, 1, C( IOFFC ), LDC ) + END IF + * +@@ -421,9 +421,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = MP+1 + CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -441,7 +441,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * +@@ -471,7 +471,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -480,7 +480,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -500,8 +500,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - v * w' + * + IF( IOFFC.GT.0 ) +- $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -516,18 +516,18 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( JJV ) + CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * + IPW = MP+1 + CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -547,8 +547,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - v * w' + * + IF( IOFFC.GT.0 ) +- $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -577,9 +577,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYROW.EQ.ICROW ) THEN + * +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -597,7 +597,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - w * v' + * + IF( IOFFV.GT.0 .AND. IOFFC.GT.0 ) +- $ CALL CGERC( MP, NQ, -TAULOC, WORK, 1, ++ $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC ), + $ LDC ) + END IF +@@ -621,9 +621,9 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = NQ+1 + CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -641,8 +641,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -667,7 +667,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -676,7 +676,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -694,8 +694,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -720,18 +720,18 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( IIV ) + CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * + IPW = NQ+1 + CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -750,8 +750,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - w * v' + * + IF( IOFFC.GT.0 ) +- $ CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ $ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -770,7 +770,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -779,7 +779,7 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -797,8 +797,8 @@ SUBROUTINE PCLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, +- $ C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +diff --git a/SRC/pclarfc.f b/SRC/pclarfc.f +index d6a2d3b..f84c493 100644 +--- a/SRC/pclarfc.f ++++ b/SRC/pclarfc.f +@@ -242,7 +242,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, + $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, + $ NQ, RDEST +- COMPLEX TAULOC ++ COMPLEX TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, CCOPY, CGEBR2D, CGEBS2D, +@@ -336,17 +336,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = CONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = CONJG( TAU( IIV ) ) + * + ELSE + * + CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAULOC, 1, IVROW, MYCOL ) +- TAULOC = CONJG( TAULOC ) ++ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -364,8 +364,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -380,9 +380,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYCOL.EQ.ICCOL ) THEN + * +- TAULOC = CONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = CONJG( TAU( JJV ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -399,7 +399,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL CGERC( MP, NQ, -TAULOC, V( IOFFV ), 1, ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, + $ WORK, 1, C( IOFFC ), LDC ) + END IF + * +@@ -422,9 +422,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = MP+1 + CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = CONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = CONJG( WORK( IPW ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -442,7 +442,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * +@@ -472,17 +472,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = CONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = CONJG( TAU( IIV ) ) + * + ELSE + * + CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, + $ 1, IVROW, MYCOL ) +- TAULOC = CONJG( TAULOC ) ++ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -500,8 +500,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1, +- $ C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -516,18 +516,18 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( JJV ) + CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = CONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = CONJG( TAU( JJV ) ) + * + ELSE + * + IPW = MP+1 + CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = CONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = CONJG( WORK( IPW ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -545,8 +545,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1, +- $ C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -575,9 +575,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYROW.EQ.ICROW ) THEN + * +- TAULOC = CONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = CONJG( TAU( IIV ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -594,7 +594,7 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK, 1, ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC ), LDC ) + END IF + * +@@ -617,9 +617,9 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = NQ+1 + CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = CONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = CONJG( WORK( IPW ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -637,8 +637,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -663,17 +663,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = CONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = CONJG( TAU( JJV ) ) + * + ELSE + * + CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, + $ 1, MYROW, IVCOL ) +- TAULOC = CONJG( TAULOC ) ++ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -691,8 +691,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -716,18 +716,18 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( IIV ) + CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = CONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = CONJG( TAU( IIV ) ) + * + ELSE + * + IPW = NQ+1 + CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = CONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = CONJG( WORK( IPW ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -745,8 +745,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, +- $ C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -765,17 +765,17 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = CONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = CONJG( TAU( JJV ) ) + * + ELSE + * + CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1, + $ MYROW, IVCOL ) +- TAULOC = CONJG( TAULOC ) ++ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -793,8 +793,8 @@ SUBROUTINE PCLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, +- $ C( IOFFC ), LDC ) ++ CALL CGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +diff --git a/SRC/pclarz.f b/SRC/pclarz.f +index 9ba730c..673860a 100644 +--- a/SRC/pclarz.f ++++ b/SRC/pclarz.f +@@ -251,7 +251,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, + $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, + $ NQC2, NQV, RDEST +- COMPLEX TAULOC ++ COMPLEX TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, CAXPY, CCOPY, CGEBR2D, +@@ -370,7 +370,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -379,7 +379,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -402,9 +402,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -420,9 +420,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYCOL.EQ.ICCOL2 ) THEN + * +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -445,11 +445,11 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK, ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK, + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -471,9 +471,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = MPV+1 + CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -496,10 +496,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -530,16 +530,16 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +- CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, +- $ 1, IVROW, MYCOL ) ++ CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ++ $ TAULOC( 1 ), 1, IVROW, MYCOL ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -562,10 +562,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -580,18 +580,18 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( JJV ) + CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * + IPW = MPV+1 + CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -614,10 +614,10 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -646,9 +646,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYROW.EQ.ICROW2 ) THEN + * +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -669,13 +669,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ ICCOL2 ) + * + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK, 1, ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK, 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * + IF( MPC2.GT.0 .AND. NQV.GT.0 ) +- $ CALL CGERC( MPC2, NQV, -TAULOC, WORK, 1, ++ $ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC2 ), + $ LDC ) + END IF +@@ -699,9 +699,9 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = NQV+1 + CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -720,13 +720,14 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), + $ RDEST, ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, +- $ C( IOFFC1 ), 1 ) ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), ++ $ WORK( IPW ), 1, WORK, 1, ++ $ C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -751,16 +752,16 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +- CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, +- $ 1, MYROW, IVCOL ) ++ CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, ++ $ TAULOC( 1 ), 1, MYROW, IVCOL ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -779,13 +780,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -809,18 +810,18 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( IIV ) + CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * + IPW = NQV+1 + CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -840,13 +841,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -865,7 +866,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -874,7 +875,7 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -893,13 +894,13 @@ SUBROUTINE PCLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +diff --git a/SRC/pclarzc.f b/SRC/pclarzc.f +index f1bc21e..b6d3b6d 100644 +--- a/SRC/pclarzc.f ++++ b/SRC/pclarzc.f +@@ -251,7 +251,7 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, + $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, + $ NQC2, NQV, RDEST +- COMPLEX TAULOC ++ COMPLEX TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, CAXPY, CCOPY, CGEBR2D, +@@ -370,17 +370,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = CONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = CONJG( TAU( IIV ) ) + * + ELSE + * + CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAULOC, 1, IVROW, MYCOL ) +- TAULOC = CONJG( TAULOC ) ++ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -403,9 +403,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -421,9 +421,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYCOL.EQ.ICCOL2 ) THEN + * +- TAULOC = CONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = CONJG( TAU( JJV ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -446,11 +446,11 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK, ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK, + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -472,9 +472,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = MPV+1 + CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = CONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = CONJG( WORK( IPW ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -497,10 +497,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -531,17 +531,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL CGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = CONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = CONJG( TAU( IIV ) ) + * + ELSE + * + CALL CGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, + $ 1, IVROW, MYCOL ) +- TAULOC = CONJG( TAULOC ) ++ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -564,10 +564,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -582,18 +582,18 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( JJV ) + CALL CGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = CONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = CONJG( TAU( JJV ) ) + * + ELSE + * + IPW = MPV+1 + CALL CGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = CONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = CONJG( WORK( IPW ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -616,10 +616,10 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL CAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL CAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL CGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -648,9 +648,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYROW.EQ.ICROW2 ) THEN + * +- TAULOC = CONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = CONJG( TAU( IIV ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -671,12 +671,12 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ ICCOL2 ) + * + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK, 1, ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK, 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MPC2, NQV, -TAULOC, WORK, 1, ++ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC2 ), LDC ) + END IF + * +@@ -699,9 +699,9 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = NQV+1 + CALL CGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = CONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = CONJG( WORK( IPW ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -720,13 +720,14 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), + $ RDEST, ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, +- $ C( IOFFC1 ), 1 ) ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), ++ $ WORK( IPW ), 1, WORK, 1, ++ $ C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -751,17 +752,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = CONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = CONJG( TAU( JJV ) ) + * + ELSE + * + CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, + $ 1, MYROW, IVCOL ) +- TAULOC = CONJG( TAULOC ) ++ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -780,13 +781,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -810,18 +811,18 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( IIV ) + CALL CGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = CONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = CONJG( TAU( IIV ) ) + * + ELSE + * + IPW = NQV+1 + CALL CGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = CONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = CONJG( WORK( IPW ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -841,13 +842,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -866,17 +867,17 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL CGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = CONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = CONJG( TAU( JJV ) ) + * + ELSE + * +- CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1, +- $ MYROW, IVCOL ) +- TAULOC = CONJG( TAULOC ) ++ CALL CGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, ++ $ TAULOC( 1 ), 1, MYROW, IVCOL ) ++ TAULOC( 1 ) = CONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -895,13 +896,13 @@ SUBROUTINE PCLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL CAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL CAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL CGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL CGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +diff --git a/SRC/pclattrs.f b/SRC/pclattrs.f +index c744aea..0d12a8b 100644 +--- a/SRC/pclattrs.f ++++ b/SRC/pclattrs.f +@@ -271,7 +271,8 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + $ JINC, JLAST, LDA, LDX, MB, MYCOL, MYROW, NB, + $ NPCOL, NPROW, RSRC + REAL BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL, +- $ XBND, XJ, XMAX ++ $ XBND, XJ ++ REAL XMAX( 1 ) + COMPLEX CSUMJ, TJJS, USCAL, XJTMP, ZDUM + * .. + * .. External Functions .. +@@ -391,11 +392,11 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + * Compute a bound on the computed solution vector to see if the + * Level 2 PBLAS routine PCTRSV can be used. + * +- XMAX = ZERO ++ XMAX( 1 ) = ZERO + CALL PCAMAX( N, ZDUM, IMAX, X, IX, JX, DESCX, 1 ) +- XMAX = CABS2( ZDUM ) ++ XMAX( 1 ) = CABS2( ZDUM ) + CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, -1, -1 ) +- XBND = XMAX ++ XBND = XMAX( 1 ) + * + IF( NOTRAN ) THEN + * +@@ -590,16 +591,16 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + * + * Use a Level 1 PBLAS solve, scaling intermediate results. + * +- IF( XMAX.GT.BIGNUM*HALF ) THEN ++ IF( XMAX( 1 ).GT.BIGNUM*HALF ) THEN + * + * Scale X so that its components are less than or equal to + * BIGNUM in absolute value. + * +- SCALE = ( BIGNUM*HALF ) / XMAX ++ SCALE = ( BIGNUM*HALF ) / XMAX( 1 ) + CALL PCSSCAL( N, SCALE, X, IX, JX, DESCX, 1 ) +- XMAX = BIGNUM ++ XMAX( 1 ) = BIGNUM + ELSE +- XMAX = XMAX*TWO ++ XMAX( 1 ) = XMAX( 1 )*TWO + END IF + * + IF( NOTRAN ) THEN +@@ -651,7 +652,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * X( J ) = CLADIV( X( J ), TJJS ) +@@ -682,7 +683,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + * X( J ) = CLADIV( X( J ), TJJS ) + * XJ = CABS1( X( J ) ) +@@ -706,7 +707,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + XJTMP = CONE + XJ = ONE + SCALE = ZERO +- XMAX = ZERO ++ XMAX( 1 ) = ZERO + END IF + 90 CONTINUE + * +@@ -715,7 +716,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + * + IF( XJ.GT.ONE ) THEN + REC = ONE / XJ +- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN ++ IF( CNORM( J ).GT.( BIGNUM-XMAX( 1 ) )*REC ) THEN + * + * Scale x by 1/(2*abs(x(j))). + * +@@ -724,7 +725,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + XJTMP = XJTMP*REC + SCALE = SCALE*REC + END IF +- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN ++ ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX( 1 ) ) ) THEN + * + * Scale x by 1/2. + * +@@ -743,7 +744,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCAXPY( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1, X, + $ IX, JX, DESCX, 1 ) + CALL PCAMAX( J-1, ZDUM, IMAX, X, IX, JX, DESCX, 1 ) +- XMAX = CABS1( ZDUM ) ++ XMAX( 1 ) = CABS1( ZDUM ) + CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, + $ -1, -1 ) + END IF +@@ -757,7 +758,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCAXPY( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1, + $ X, IX+J, JX, DESCX, 1 ) + CALL PCAMAX( N-J, ZDUM, I, X, IX+J, JX, DESCX, 1 ) +- XMAX = CABS1( ZDUM ) ++ XMAX( 1 ) = CABS1( ZDUM ) + CALL SGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, + $ -1, -1 ) + END IF +@@ -785,7 +786,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + END IF + XJ = CABS1( XJTMP ) + USCAL = CMPLX( TSCAL ) +- REC = ONE / MAX( XMAX, ONE ) ++ REC = ONE / MAX( XMAX( 1 ), ONE ) + IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN + * + * If x(j) could overflow, scale x by 1/(2*XMAX). +@@ -820,7 +821,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * +@@ -924,7 +925,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * X( J ) = CLADIV( X( J ), TJJS ) +@@ -945,7 +946,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + * X( J ) = CLADIV( X( J ), TJJS ) + XJTMP = CLADIV( XJTMP, TJJS ) +@@ -966,7 +967,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + END IF + XJTMP = CONE + SCALE = ZERO +- XMAX = ZERO ++ XMAX( 1 ) = ZERO + END IF + 110 CONTINUE + ELSE +@@ -981,7 +982,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + X( IROWX ) = XJTMP + END IF + END IF +- XMAX = MAX( XMAX, CABS1( XJTMP ) ) ++ XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) ) + 120 CONTINUE + * + ELSE +@@ -1004,7 +1005,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + END IF + XJ = CABS1( XJTMP ) + USCAL = TSCAL +- REC = ONE / MAX( XMAX, ONE ) ++ REC = ONE / MAX( XMAX( 1 ), ONE ) + IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN + * + * If x(j) could overflow, scale x by 1/(2*XMAX). +@@ -1039,7 +1040,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * +@@ -1145,7 +1146,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * X( J ) = CLADIV( X( J ), TJJS ) +@@ -1164,7 +1165,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PCSSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + * X( J ) = CLADIV( X( J ), TJJS ) + XJTMP = CLADIV( XJTMP, TJJS ) +@@ -1181,7 +1182,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + $ X( IROWX ) = CONE + XJTMP = CONE + SCALE = ZERO +- XMAX = ZERO ++ XMAX( 1 ) = ZERO + END IF + 130 CONTINUE + ELSE +@@ -1194,7 +1195,7 @@ SUBROUTINE PCLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) ) + $ X( IROWX ) = XJTMP + END IF +- XMAX = MAX( XMAX, CABS1( XJTMP ) ) ++ XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) ) + 140 CONTINUE + END IF + SCALE = SCALE / TSCAL +diff --git a/SRC/pclawil.f b/SRC/pclawil.f +index 24a49b9..b33b3b1 100644 +--- a/SRC/pclawil.f ++++ b/SRC/pclawil.f +@@ -124,11 +124,10 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT, + $ RSRC, UP + REAL S +- COMPLEX CDUM, H11, H12, H21, H22, H33S, H44S, V1, V2, +- $ V3 ++ COMPLEX CDUM, H22, H33S, H44S, V1, V2 + * .. + * .. Local Arrays .. +- COMPLEX BUF( 4 ) ++ COMPLEX BUF( 4 ), V3( 1 ), H11( 1 ), H12( 1 ), H21( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, INFOG2L, CGERV2D, CGESD2D +@@ -181,18 +180,18 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( NPCOL.GT.1 ) THEN + CALL CGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT ) + ELSE +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + IF( NUM.GT.1 ) THEN + CALL CGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT ) +- H11 = BUF( 1 ) +- H21 = BUF( 2 ) +- H12 = BUF( 3 ) ++ H11( 1 ) = BUF( 1 ) ++ H21( 1 ) = BUF( 2 ) ++ H12( 1 ) = BUF( 3 ) + H22 = BUF( 4 ) + ELSE +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) + END IF + END IF +@@ -223,22 +222,22 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, + $ IROW, ICOL, RSRC, JSRC ) + IF( NUM.GT.1 ) THEN +- CALL CGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT ) ++ CALL CGERV2D( CONTXT, 1, 1, H11( 1 ), 1, UP, LEFT ) + ELSE +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) + END IF + IF( NPROW.GT.1 ) THEN + CALL CGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL ) + ELSE +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + END IF + IF( NPCOL.GT.1 ) THEN +- CALL CGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT ) ++ CALL CGERV2D( CONTXT, 1, 1, H21( 1 ), 1, MYROW, LEFT ) + ELSE +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) + END IF + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + END IF + IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) +@@ -247,24 +246,24 @@ SUBROUTINE PCLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( MODKM1.GT.1 ) THEN + CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, + $ IROW, ICOL, RSRC, JSRC ) +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + * +- H44S = H44 - H11 +- H33S = H33 - H11 +- V1 = ( H33S*H44S-H43H34 ) / H21 + H12 +- V2 = H22 - H11 - H33S - H44S +- S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3 ) ++ H44S = H44 - H11( 1 ) ++ H33S = H33 - H11( 1 ) ++ V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 ) ++ V2 = H22 - H11( 1 ) - H33S - H44S ++ S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3( 1 ) ) + V1 = V1 / S + V2 = V2 / S +- V3 = V3 / S ++ V3( 1 ) = V3( 1 ) / S + V( 1 ) = V1 + V( 2 ) = V2 +- V( 3 ) = V3 ++ V( 3 ) = V3( 1 ) + * + RETURN + * +diff --git a/SRC/pctrevc.f b/SRC/pctrevc.f +index d0a3043..bf6c52b 100644 +--- a/SRC/pctrevc.f ++++ b/SRC/pctrevc.f +@@ -218,11 +218,12 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + $ ITMP2, J, K, KI, LDT, LDVL, LDVR, LDW, MB, + $ MYCOL, MYROW, NB, NPCOL, NPROW, RSRC + REAL SELF +- REAL OVFL, REMAXD, SCALE, SMIN, SMLNUM, ULP, UNFL ++ REAL OVFL, REMAXD, SCALE, SMLNUM, ULP, UNFL + COMPLEX CDUM, REMAXC, SHIFT + * .. + * .. Local Arrays .. + INTEGER DESCW( DLEN_ ) ++ REAL SMIN( 1 ) + * .. + * .. External Functions .. + LOGICAL LSAME +@@ -355,13 +356,13 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + $ GO TO 70 + END IF + * +- SMIN = ZERO ++ SMIN( 1 ) = ZERO + SHIFT = CZERO + CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL, + $ IROW, ICOL, ITMP1, ITMP2 ) + IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN + SHIFT = T( ( ICOL-1 )*LDT+IROW ) +- SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) ++ SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) + END IF + CALL SGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 ) + CALL CGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 ) +@@ -396,8 +397,9 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN + T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) - + $ SHIFT +- IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) THEN +- T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN ) ++ IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) ) ++ $ THEN ++ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN( 1 ) ) + END IF + END IF + 50 CONTINUE +@@ -467,13 +469,13 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + $ GO TO 110 + END IF + * +- SMIN = ZERO ++ SMIN( 1 ) = ZERO + SHIFT = CZERO + CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL, + $ IROW, ICOL, ITMP1, ITMP2 ) + IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN + SHIFT = T( ( ICOL-1 )*LDT+IROW ) +- SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) ++ SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) + END IF + CALL SGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 ) + CALL CGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 ) +@@ -507,8 +509,8 @@ SUBROUTINE PCTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN + T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) - + $ SHIFT +- IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) +- $ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN ) ++ IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) ) ++ $ T( ( ICOL-1 )*LDT+IROW ) = CMPLX( SMIN( 1 ) ) + END IF + 90 CONTINUE + * +diff --git a/SRC/pdhseqr.f b/SRC/pdhseqr.f +index ffc3652..6e0f751 100644 +--- a/SRC/pdhseqr.f ++++ b/SRC/pdhseqr.f +@@ -259,11 +259,12 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, + $ HRSRC4, HCSRC4, LIWKOPT + LOGICAL INITZ, LQUERY, WANTT, WANTZ, PAIR, BORDER + DOUBLE PRECISION TMP1, TMP2, TMP3, TMP4, DUM1, DUM2, DUM3, +- $ DUM4, ELEM1, ELEM2, ELEM3, ELEM4, ++ $ DUM4, ELEM1, ELEM4, + $ CS, SN, ELEM5, TMP, LWKOPT + * .. + * .. Local Arrays .. + INTEGER DESCH2( DLEN_ ) ++ DOUBLE PRECISION ELEM2( 1 ), ELEM3( 1 ) + * .. + * .. External Functions .. + INTEGER PILAENVX, NUMROC, ICEIL +@@ -566,28 +567,28 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, + IF( MYROW.EQ.HRSRC1 .AND. MYCOL.EQ.HCSRC1 ) THEN + ELEM1 = H((JLOC1-1)*LLDH+ILOC1) + IF( K.LT.N ) THEN +- ELEM3 = H((JLOC1-1)*LLDH+ILOC1+1) ++ ELEM3( 1 ) = H((JLOC1-1)*LLDH+ILOC1+1) + ELSE +- ELEM3 = ZERO ++ ELEM3( 1 ) = ZERO + END IF +- IF( ELEM3.NE.ZERO ) THEN +- ELEM2 = H((JLOC1)*LLDH+ILOC1) ++ IF( ELEM3( 1 ).NE.ZERO ) THEN ++ ELEM2( 1 ) = H((JLOC1)*LLDH+ILOC1) + ELEM4 = H((JLOC1)*LLDH+ILOC1+1) +- CALL DLANV2( ELEM1, ELEM2, ELEM3, ELEM4, +- $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), +- $ SN, CS ) ++ CALL DLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ++ $ ELEM4, WR( K ), WI( K ), WR( K+1 ), ++ $ WI( K+1 ), SN, CS ) + PAIR = .TRUE. + ELSE + IF( K.GT.1 ) THEN + TMP = H((JLOC1-2)*LLDH+ILOC1) + IF( TMP.NE.ZERO ) THEN + ELEM1 = H((JLOC1-2)*LLDH+ILOC1-1) +- ELEM2 = H((JLOC1-1)*LLDH+ILOC1-1) +- ELEM3 = H((JLOC1-2)*LLDH+ILOC1) ++ ELEM2( 1 ) = H((JLOC1-1)*LLDH+ILOC1-1) ++ ELEM3( 1 ) = H((JLOC1-2)*LLDH+ILOC1) + ELEM4 = H((JLOC1-1)*LLDH+ILOC1) +- CALL DLANV2( ELEM1, ELEM2, ELEM3, +- $ ELEM4, WR( K-1 ), WI( K-1 ), +- $ WR( K ), WI( K ), SN, CS ) ++ CALL DLANV2( ELEM1, ELEM2( 1 ), ++ $ ELEM3( 1 ), ELEM4, WR( K-1 ), ++ $ WI( K-1 ), WR( K ), WI( K ), SN, CS ) + ELSE + WR( K ) = ELEM1 + END IF +@@ -620,12 +621,12 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, + CALL INFOG2L( K+1, K+1, DESCH, NPROW, NPCOL, MYROW, MYCOL, + $ ILOC4, JLOC4, HRSRC4, HCSRC4 ) + IF( MYROW.EQ.HRSRC2 .AND. MYCOL.EQ.HCSRC2 ) THEN +- ELEM2 = H((JLOC2-1)*LLDH+ILOC2) ++ ELEM2( 1 ) = H((JLOC2-1)*LLDH+ILOC2) + IF( HRSRC1.NE.HRSRC2 .OR. HCSRC1.NE.HCSRC2 ) + $ CALL DGESD2D( ICTXT, 1, 1, ELEM2, 1, HRSRC1, HCSRC1) + END IF + IF( MYROW.EQ.HRSRC3 .AND. MYCOL.EQ.HCSRC3 ) THEN +- ELEM3 = H((JLOC3-1)*LLDH+ILOC3) ++ ELEM3( 1 ) = H((JLOC3-1)*LLDH+ILOC3) + IF( HRSRC1.NE.HRSRC3 .OR. HCSRC1.NE.HCSRC3 ) + $ CALL DGESD2D( ICTXT, 1, 1, ELEM3, 1, HRSRC1, HCSRC1) + END IF +@@ -651,8 +652,9 @@ SUBROUTINE PDHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, + ELEM5 = WORK(2) + IF( ELEM5.EQ.ZERO ) THEN + IF( WR( K ).EQ.ZERO .AND. WI( K ).EQ.ZERO ) THEN +- CALL DLANV2( ELEM1, ELEM2, ELEM3, ELEM4, WR( K ), +- $ WI( K ), WR( K+1 ), WI( K+1 ), SN, CS ) ++ CALL DLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ELEM4, ++ $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), SN, ++ $ CS ) + ELSEIF( WR( K+1 ).EQ.ZERO .AND. WI( K+1 ).EQ.ZERO ) + $ THEN + WR( K+1 ) = ELEM4 +diff --git a/SRC/pdlacon.f b/SRC/pdlacon.f +index b625d97..74b9eab 100644 +--- a/SRC/pdlacon.f ++++ b/SRC/pdlacon.f +@@ -160,10 +160,10 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + INTEGER I, ICTXT, IFLAG, IIVX, IMAXROW, IOFFVX, IROFF, + $ ITER, IVXCOL, IVXROW, J, JLAST, JJVX, JUMP, + $ K, MYCOL, MYROW, NP, NPCOL, NPROW +- DOUBLE PRECISION ALTSGN, ESTOLD, JLMAX, TEMP, XMAX ++ DOUBLE PRECISION ALTSGN, ESTOLD, JLMAX, XMAX + * .. + * .. Local Arrays .. +- DOUBLE PRECISION WORK( 2 ) ++ DOUBLE PRECISION ESTWORK( 1 ), TEMP( 1 ), WORK( 2 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, DCOPY, DGEBR2D, DGEBS2D, +@@ -184,6 +184,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + * + * Get grid parameters. + * ++ ESTWORK( 1 ) = EST + ICTXT = DESCX( CTXT_ ) + CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) + * +@@ -215,21 +216,21 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + IF( N.EQ.1 ) THEN + IF( MYROW.EQ.IVXROW ) THEN + V( IOFFVX ) = X( IOFFVX ) +- EST = ABS( V( IOFFVX ) ) +- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) ++ ESTWORK( 1 ) = ABS( V( IOFFVX ) ) ++ CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) + ELSE +- CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, ++ CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, + $ IVXROW, MYCOL ) + END IF + * ... QUIT + GO TO 150 + END IF +- CALL PDASUM( N, EST, X, IX, JX, DESCX, 1 ) ++ CALL PDASUM( N, ESTWORK( 1 ), X, IX, JX, DESCX, 1 ) + IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN + IF( MYROW.EQ.IVXROW ) THEN +- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) ++ CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) + ELSE +- CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, ++ CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, + $ IVXROW, MYCOL ) + END IF + END IF +@@ -281,13 +282,13 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + * + 70 CONTINUE + CALL DCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 ) +- ESTOLD = EST +- CALL PDASUM( N, EST, V, IV, JV, DESCV, 1 ) ++ ESTOLD = ESTWORK( 1 ) ++ CALL PDASUM( N, ESTWORK( 1 ), V, IV, JV, DESCV, 1 ) + IF( DESCV( M_ ).EQ.1 .AND. N.EQ.1 ) THEN + IF( MYROW.EQ.IVXROW ) THEN +- CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) ++ CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) + ELSE +- CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, ++ CALL DGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, + $ IVXROW, MYCOL ) + END IF + END IF +@@ -305,7 +306,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. + * ALONG WITH IT, TEST FOR CYCLING. + * +- IF( IFLAG.EQ.0 .OR. EST.LE.ESTOLD ) ++ IF( IFLAG.EQ.0 .OR. ESTWORK( 1 ).LE.ESTOLD ) + $ GO TO 120 + * + DO 100 I = IOFFVX, IOFFVX+NP-1 +@@ -361,7 +362,7 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + * X HAS BEEN OVERWRITTEN BY A*X + * + 140 CONTINUE +- CALL PDASUM( N, TEMP, X, IX, JX, DESCX, 1 ) ++ CALL PDASUM( N, TEMP( 1 ), X, IX, JX, DESCX, 1 ) + IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN + IF( MYROW.EQ.IVXROW ) THEN + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, TEMP, 1 ) +@@ -370,15 +371,16 @@ SUBROUTINE PDLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + $ IVXROW, MYCOL ) + END IF + END IF +- TEMP = TWO*( TEMP / DBLE( 3*N ) ) +- IF( TEMP.GT.EST ) THEN ++ TEMP( 1 ) = TWO*( TEMP( 1 ) / DBLE( 3*N ) ) ++ IF( TEMP( 1 ).GT.ESTWORK( 1 ) ) THEN + CALL DCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 ) +- EST = TEMP ++ ESTWORK( 1 ) = TEMP( 1 ) + END IF + * + 150 CONTINUE + KASE = 0 + * ++ EST = ESTWORK( 1 ) + RETURN + * + * End of PDLACON +diff --git a/SRC/pdlarf.f b/SRC/pdlarf.f +index 29da1ac..41368d6 100644 +--- a/SRC/pdlarf.f ++++ b/SRC/pdlarf.f +@@ -241,7 +241,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, + $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, + $ NQ, RDEST +- DOUBLE PRECISION TAULOC ++ DOUBLE PRECISION TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, DCOPY, DGEBR2D, DGEBS2D, +@@ -335,7 +335,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -344,7 +344,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -362,8 +362,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -378,9 +378,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYCOL.EQ.ICCOL ) THEN + * +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -397,8 +397,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL DGER( MP, NQ, -TAULOC, V( IOFFV ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ CALL DGER( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -420,9 +420,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = MP+1 + CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -440,7 +440,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL DGER( MP, NQ, -TAULOC, WORK, 1, ++ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * +@@ -470,7 +470,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -479,7 +479,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -499,8 +499,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - v * w' + * + IF( IOFFC.GT.0 ) +- $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -515,18 +515,18 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( JJV ) + CALL DGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * + IPW = MP+1 + CALL DGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -546,8 +546,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - v * w' + * + IF( IOFFC.GT.0 ) +- $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -576,9 +576,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYROW.EQ.ICROW ) THEN + * +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -596,7 +596,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - w * v' + * + IF( IOFFV.GT.0 .AND. IOFFC.GT.0 ) +- $ CALL DGER( MP, NQ, -TAULOC, WORK, 1, ++ $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC ), LDC ) + END IF + * +@@ -619,9 +619,9 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = NQ+1 + CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -639,7 +639,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, ++ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, + $ WORK, 1, C( IOFFC ), LDC ) + END IF + * +@@ -665,7 +665,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -674,7 +674,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -692,8 +692,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -718,18 +718,18 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( IIV ) + CALL DGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * + IPW = NQ+1 + CALL DGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -748,8 +748,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - w * v' + * + IF( IOFFC.GT.0 ) +- $ CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ $ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -768,7 +768,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -777,7 +777,7 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -795,8 +795,8 @@ SUBROUTINE PDLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL DGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, +- $ C( IOFFC ), LDC ) ++ CALL DGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, WORK, ++ $ 1, C( IOFFC ), LDC ) + END IF + * + END IF +diff --git a/SRC/pdlarz.f b/SRC/pdlarz.f +index b91282c..f45c137 100644 +--- a/SRC/pdlarz.f ++++ b/SRC/pdlarz.f +@@ -250,7 +250,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, + $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, + $ NQC2, NQV, RDEST +- DOUBLE PRECISION TAULOC ++ DOUBLE PRECISION TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, DAXPY, DCOPY, DGEBR2D, +@@ -369,7 +369,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -378,7 +378,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -401,9 +401,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -419,9 +419,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYCOL.EQ.ICCOL2 ) THEN + * +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -444,11 +444,11 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL DAXPY( NQC2, -TAULOC, WORK, ++ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK, + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL DGER( MPV, NQC2, -TAULOC, V( IOFFV ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL DGER( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -470,9 +470,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = MPV+1 + CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -495,10 +495,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -529,7 +529,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL DGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -538,7 +538,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -561,10 +561,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -579,18 +579,18 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( JJV ) + CALL DGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * + IPW = MPV+1 + CALL DGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -613,10 +613,10 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL DAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL DAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL DGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL DGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -645,9 +645,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYROW.EQ.ICROW2 ) THEN + * +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -668,13 +668,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ ICCOL2 ) + * + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL DAXPY( MPC2, -TAULOC, WORK, 1, ++ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK, 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * + IF( MPC2.GT.0 .AND. NQV.GT.0 ) +- $ CALL DGER( MPC2, NQV, -TAULOC, WORK, 1, ++ $ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC2 ), + $ LDC ) + END IF +@@ -698,9 +698,9 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = NQV+1 + CALL DGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -719,13 +719,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), + $ RDEST, ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1, +- $ C( IOFFC1 ), 1 ) ++ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -750,7 +750,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -759,7 +759,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -778,12 +778,12 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, ++ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, + $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -808,18 +808,18 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( IIV ) + CALL DGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * + IPW = NQV+1 + CALL DGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -839,13 +839,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -864,7 +864,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL DGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -873,7 +873,7 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -892,13 +892,13 @@ SUBROUTINE PDLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL DAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL DAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL DGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL DGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +diff --git a/SRC/pdlawil.f b/SRC/pdlawil.f +index 90a4d74..e8bc3a0 100644 +--- a/SRC/pdlawil.f ++++ b/SRC/pdlawil.f +@@ -120,10 +120,10 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + INTEGER CONTXT, DOWN, HBL, ICOL, IROW, JSRC, LDA, LEFT, + $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT, + $ RSRC, UP +- DOUBLE PRECISION H11, H12, H21, H22, H33S, H44S, S, V1, V2, V3 ++ DOUBLE PRECISION H22, H33S, H44S, S, V1, V2 + * .. + * .. Local Arrays .. +- DOUBLE PRECISION BUF( 4 ) ++ DOUBLE PRECISION BUF( 4 ), H11( 1 ), H12( 1 ), H21( 1 ), V3( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, DGERV2D, DGESD2D, INFOG2L +@@ -170,18 +170,18 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( NPCOL.GT.1 ) THEN + CALL DGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT ) + ELSE +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + IF( NUM.GT.1 ) THEN + CALL DGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT ) +- H11 = BUF( 1 ) +- H21 = BUF( 2 ) +- H12 = BUF( 3 ) ++ H11( 1 ) = BUF( 1 ) ++ H21( 1 ) = BUF( 2 ) ++ H12( 1 ) = BUF( 3 ) + H22 = BUF( 4 ) + ELSE +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) + END IF + END IF +@@ -214,20 +214,20 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( NUM.GT.1 ) THEN + CALL DGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT ) + ELSE +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) + END IF + IF( NPROW.GT.1 ) THEN + CALL DGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL ) + ELSE +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + END IF + IF( NPCOL.GT.1 ) THEN + CALL DGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT ) + ELSE +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) + END IF + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + END IF + IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) +@@ -236,24 +236,24 @@ SUBROUTINE PDLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( MODKM1.GT.1 ) THEN + CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, + $ IROW, ICOL, RSRC, JSRC ) +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + * +- H44S = H44 - H11 +- H33S = H33 - H11 +- V1 = ( H33S*H44S-H43H34 ) / H21 + H12 +- V2 = H22 - H11 - H33S - H44S +- S = ABS( V1 ) + ABS( V2 ) + ABS( V3 ) ++ H44S = H44 - H11( 1 ) ++ H33S = H33 - H11( 1 ) ++ V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 ) ++ V2 = H22 - H11( 1 ) - H33S - H44S ++ S = ABS( V1 ) + ABS( V2 ) + ABS( V3( 1 ) ) + V1 = V1 / S + V2 = V2 / S +- V3 = V3 / S ++ V3( 1 ) = V3( 1 ) / S + V( 1 ) = V1 + V( 2 ) = V2 +- V( 3 ) = V3 ++ V( 3 ) = V3( 1 ) + * + RETURN + * +diff --git a/SRC/pdstebz.f b/SRC/pdstebz.f +index e7006f9..bf4dacc 100644 +--- a/SRC/pdstebz.f ++++ b/SRC/pdstebz.f +@@ -246,14 +246,14 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, + $ ITMP2, J, JB, K, LAST, LEXTRA, LREQ, MYCOL, + $ MYROW, NALPHA, NBETA, NCMP, NEIGINT, NEXT, NGL, + $ NGLOB, NGU, NINT, NPCOL, NPROW, OFFSET, +- $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF, +- $ TORECV ++ $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF + DOUBLE PRECISION ALPHA, ATOLI, BETA, BNORM, DRECV, DSEND, GL, + $ GU, INITVL, INITVU, LSAVE, MID, PIVMIN, RELTOL, + $ SAFEMN, TMP1, TMP2, TNORM, ULP + * .. + * .. Local Arrays .. + INTEGER IDUM( 5, 2 ) ++ INTEGER TORECV( 1, 1 ) + * .. + * .. Executable Statements .. + * This is just to keep ftnchek happy +@@ -784,14 +784,14 @@ SUBROUTINE PDSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, + ELSE + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', 1, 1, TORECV, 1, 0, + $ I-1 ) +- IF( TORECV.NE.0 ) THEN +- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, IWORK, +- $ TORECV, 0, I-1 ) +- CALL DGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, WORK, +- $ TORECV, 0, I-1 ) +- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, +- $ IWORK( N+1 ), TORECV, 0, I-1 ) +- DO 120 J = 1, TORECV ++ IF( TORECV( 1, 1 ).NE.0 ) THEN ++ CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, ++ $ IWORK, TORECV( 1, 1 ), 0, I-1 ) ++ CALL DGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, ++ $ WORK, TORECV( 1, 1 ), 0, I-1 ) ++ CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, ++ $ IWORK( N+1 ), TORECV( 1, 1 ), 0, I-1 ) ++ DO 120 J = 1, TORECV( 1, 1 ) + W( IWORK( J ) ) = WORK( J ) + IBLOCK( IWORK( J ) ) = IWORK( N+J ) + 120 CONTINUE +diff --git a/SRC/pdtrord.f b/SRC/pdtrord.f +index 1f37d8e..3870574 100644 +--- a/SRC/pdtrord.f ++++ b/SRC/pdtrord.f +@@ -328,12 +328,13 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + $ EAST, WEST, ILOC4, SOUTH, NORTH, INDXS, + $ ITT, JTT, ILEN, DLEN, INDXE, TRSRC1, TCSRC1, + $ TRSRC2, TCSRC2, ILOS, DIR, TLIHI, TLILO, TLSEL, +- $ ROUND, LAST, WIN0S, WIN0E, WINE, MMAX, MMIN ++ $ ROUND, LAST, WIN0S, WIN0E, WINE + DOUBLE PRECISION ELEM, ELEM1, ELEM2, ELEM3, ELEM4, SN, CS, TMP, + $ ELEM5 + * .. + * .. Local Arrays .. +- INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ) ++ INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ), MMAX( 1 ), ++ $ MMIN( 1 ), INFODUM( 1 ) + * .. + * .. External Functions .. + LOGICAL LSAME +@@ -483,16 +484,16 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + END IF + IF( SELECT(K).NE.0 ) M = M + 1 + 10 CONTINUE +- MMAX = M +- MMIN = M ++ MMAX( 1 ) = M ++ MMIN( 1 ) = M + IF( NPROCS.GT.1 ) + $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1, + $ -1, -1, -1, -1 ) + IF( NPROCS.GT.1 ) + $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1, + $ -1, -1, -1, -1 ) +- IF( MMAX.GT.MMIN ) THEN +- M = MMAX ++ IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN ++ M = MMAX( 1 ) + IF( NPROCS.GT.1 ) + $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, SELECT, N, + $ -1, -1, -1, -1, -1 ) +@@ -520,9 +521,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * + * Global maximum on info. + * +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, -1, + $ -1, -1 ) ++ INFO = INFODUM( 1 ) ++ END IF + * + * Return if some argument is incorrect. + * +@@ -1576,9 +1579,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * experienced a failure in the reordering. + * + MYIERR = IERR +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, + $ -1, -1, -1, -1 ) ++ IERR = INFODUM( 1 ) ++ END IF + * + IF( IERR.NE.0 ) THEN + * +@@ -1586,9 +1591,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * to swap. + * + IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1) +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, + $ -1, -1, -1, -1 ) ++ INFO = INFODUM( 1 ) ++ END IF + GO TO 300 + END IF + * +@@ -3245,9 +3252,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * experienced a failure in the reordering. + * + MYIERR = IERR +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, + $ -1, -1, -1, -1 ) ++ IERR = INFODUM( 1 ) ++ END IF + * + IF( IERR.NE.0 ) THEN + * +@@ -3255,9 +3264,11 @@ SUBROUTINE PDTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * to swap. + * + IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1) +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, + $ -1, -1, -1, -1 ) ++ IERR = INFODUM( 1 ) ++ END IF + GO TO 300 + END IF + * +diff --git a/SRC/pdtrsen.f b/SRC/pdtrsen.f +index 78c5599..c65ea91 100644 +--- a/SRC/pdtrsen.f ++++ b/SRC/pdtrsen.f +@@ -354,13 +354,15 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, + LOGICAL LQUERY, WANTBH, WANTQ, WANTS, WANTSP + INTEGER ICOFFT12, ICTXT, IDUM1, IDUM2, IERR, ILOC1, + $ IPW1, ITER, ITT, JLOC1, JTT, K, LIWMIN, LLDT, +- $ LLDQ, LWMIN, MMAX, MMIN, MYROW, MYCOL, N1, N2, ++ $ LLDQ, LWMIN, MYROW, MYCOL, N1, N2, + $ NB, NOEXSY, NPCOL, NPROCS, NPROW, SPACE, + $ T12ROWS, T12COLS, TCOLS, TCSRC, TROWS, TRSRC, + $ WRK1, IWRK1, WRK2, IWRK2, WRK3, IWRK3 +- DOUBLE PRECISION DPDUM1, ELEM, EST, SCALE, RNORM ++ DOUBLE PRECISION ELEM, EST, SCALE, RNORM + * .. Local Arrays .. +- INTEGER DESCT12( DLEN_ ), MBNB2( 2 ) ++ INTEGER DESCT12( DLEN_ ), MBNB2( 2 ), MMAX( 1 ), ++ $ MMIN( 1 ) ++ DOUBLE PRECISION DPDUM1( 1 ) + * .. + * .. External Functions .. + LOGICAL LSAME +@@ -521,16 +523,16 @@ SUBROUTINE PDTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, + END IF + IF( SELECT(K) ) M = M + 1 + 10 CONTINUE +- MMAX = M +- MMIN = M ++ MMAX( 1 ) = M ++ MMIN( 1 ) = M + IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1, +- $ -1, -1, -1, -1 ) ++ $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX( 1 ), 1, ++ $ -1, -1, -1, -1, -1 ) + IF( NPROCS.GT.1 ) +- $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1, +- $ -1, -1, -1, -1 ) +- IF( MMAX.GT.MMIN ) THEN +- M = MMAX ++ $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN( 1 ), 1, ++ $ -1, -1, -1, -1, -1 ) ++ IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN ++ M = MMAX( 1 ) + IF( NPROCS.GT.1 ) + $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, IWORK, N, + $ -1, -1, -1, -1, -1 ) +diff --git a/SRC/pshseqr.f b/SRC/pshseqr.f +index 10eb24a..e8ecea9 100644 +--- a/SRC/pshseqr.f ++++ b/SRC/pshseqr.f +@@ -259,11 +259,12 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, + $ HRSRC4, HCSRC4, LIWKOPT + LOGICAL INITZ, LQUERY, WANTT, WANTZ, PAIR, BORDER + REAL TMP1, TMP2, TMP3, TMP4, DUM1, DUM2, DUM3, +- $ DUM4, ELEM1, ELEM2, ELEM3, ELEM4, ++ $ DUM4, ELEM1, ELEM4, + $ CS, SN, ELEM5, TMP, LWKOPT + * .. + * .. Local Arrays .. + INTEGER DESCH2( DLEN_ ) ++ REAL ELEM2( 1 ), ELEM3( 1 ) + * .. + * .. External Functions .. + INTEGER PILAENVX, NUMROC, ICEIL +@@ -566,28 +567,28 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, + IF( MYROW.EQ.HRSRC1 .AND. MYCOL.EQ.HCSRC1 ) THEN + ELEM1 = H((JLOC1-1)*LLDH+ILOC1) + IF( K.LT.N ) THEN +- ELEM3 = H((JLOC1-1)*LLDH+ILOC1+1) ++ ELEM3( 1 ) = H((JLOC1-1)*LLDH+ILOC1+1) + ELSE +- ELEM3 = ZERO ++ ELEM3( 1 ) = ZERO + END IF +- IF( ELEM3.NE.ZERO ) THEN +- ELEM2 = H((JLOC1)*LLDH+ILOC1) ++ IF( ELEM3( 1 ).NE.ZERO ) THEN ++ ELEM2( 1 ) = H((JLOC1)*LLDH+ILOC1) + ELEM4 = H((JLOC1)*LLDH+ILOC1+1) +- CALL SLANV2( ELEM1, ELEM2, ELEM3, ELEM4, +- $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), +- $ SN, CS ) ++ CALL SLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ++ $ ELEM4, WR( K ), WI( K ), WR( K+1 ), ++ $ WI( K+1 ), SN, CS ) + PAIR = .TRUE. + ELSE + IF( K.GT.1 ) THEN + TMP = H((JLOC1-2)*LLDH+ILOC1) + IF( TMP.NE.ZERO ) THEN + ELEM1 = H((JLOC1-2)*LLDH+ILOC1-1) +- ELEM2 = H((JLOC1-1)*LLDH+ILOC1-1) +- ELEM3 = H((JLOC1-2)*LLDH+ILOC1) ++ ELEM2( 1 ) = H((JLOC1-1)*LLDH+ILOC1-1) ++ ELEM3( 1 ) = H((JLOC1-2)*LLDH+ILOC1) + ELEM4 = H((JLOC1-1)*LLDH+ILOC1) +- CALL SLANV2( ELEM1, ELEM2, ELEM3, +- $ ELEM4, WR( K-1 ), WI( K-1 ), +- $ WR( K ), WI( K ), SN, CS ) ++ CALL SLANV2( ELEM1, ELEM2( 1 ), ++ $ ELEM3( 1 ), ELEM4, WR( K-1 ), ++ $ WI( K-1 ), WR( K ), WI( K ), SN, CS ) + ELSE + WR( K ) = ELEM1 + END IF +@@ -620,12 +621,12 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, + CALL INFOG2L( K+1, K+1, DESCH, NPROW, NPCOL, MYROW, MYCOL, + $ ILOC4, JLOC4, HRSRC4, HCSRC4 ) + IF( MYROW.EQ.HRSRC2 .AND. MYCOL.EQ.HCSRC2 ) THEN +- ELEM2 = H((JLOC2-1)*LLDH+ILOC2) ++ ELEM2( 1 ) = H((JLOC2-1)*LLDH+ILOC2) + IF( HRSRC1.NE.HRSRC2 .OR. HCSRC1.NE.HCSRC2 ) + $ CALL SGESD2D( ICTXT, 1, 1, ELEM2, 1, HRSRC1, HCSRC1) + END IF + IF( MYROW.EQ.HRSRC3 .AND. MYCOL.EQ.HCSRC3 ) THEN +- ELEM3 = H((JLOC3-1)*LLDH+ILOC3) ++ ELEM3( 1 ) = H((JLOC3-1)*LLDH+ILOC3) + IF( HRSRC1.NE.HRSRC3 .OR. HCSRC1.NE.HCSRC3 ) + $ CALL SGESD2D( ICTXT, 1, 1, ELEM3, 1, HRSRC1, HCSRC1) + END IF +@@ -651,8 +652,9 @@ SUBROUTINE PSHSEQR( JOB, COMPZ, N, ILO, IHI, H, DESCH, WR, WI, Z, + ELEM5 = WORK(2) + IF( ELEM5.EQ.ZERO ) THEN + IF( WR( K ).EQ.ZERO .AND. WI( K ).EQ.ZERO ) THEN +- CALL SLANV2( ELEM1, ELEM2, ELEM3, ELEM4, WR( K ), +- $ WI( K ), WR( K+1 ), WI( K+1 ), SN, CS ) ++ CALL SLANV2( ELEM1, ELEM2( 1 ), ELEM3( 1 ), ELEM4, ++ $ WR( K ), WI( K ), WR( K+1 ), WI( K+1 ), SN, ++ $ CS ) + ELSEIF( WR( K+1 ).EQ.ZERO .AND. WI( K+1 ).EQ.ZERO ) + $ THEN + WR( K+1 ) = ELEM4 +diff --git a/SRC/pslacon.f b/SRC/pslacon.f +index 20d27ff..673bf1a 100644 +--- a/SRC/pslacon.f ++++ b/SRC/pslacon.f +@@ -160,10 +160,12 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + INTEGER I, ICTXT, IFLAG, IIVX, IMAXROW, IOFFVX, IROFF, + $ ITER, IVXCOL, IVXROW, J, JLAST, JJVX, JUMP, + $ K, MYCOL, MYROW, NP, NPCOL, NPROW +- REAL ALTSGN, ESTOLD, JLMAX, TEMP, XMAX ++ REAL ALTSGN, ESTOLD, JLMAX, XMAX + * .. + * .. Local Arrays .. + REAL WORK( 2 ) ++ REAL ESTWORK( 1 ) ++ REAL TEMP( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, IGSUM2D, INFOG2L, PSAMAX, +@@ -184,6 +186,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + * + * Get grid parameters. + * ++ ESTWORK( 1 ) = EST + ICTXT = DESCX( CTXT_ ) + CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) + * +@@ -215,21 +218,21 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + IF( N.EQ.1 ) THEN + IF( MYROW.EQ.IVXROW ) THEN + V( IOFFVX ) = X( IOFFVX ) +- EST = ABS( V( IOFFVX ) ) +- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) ++ ESTWORK( 1 ) = ABS( V( IOFFVX ) ) ++ CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) + ELSE +- CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, ++ CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, + $ IVXROW, MYCOL ) + END IF + * ... QUIT + GO TO 150 + END IF +- CALL PSASUM( N, EST, X, IX, JX, DESCX, 1 ) ++ CALL PSASUM( N, ESTWORK( 1 ), X, IX, JX, DESCX, 1 ) + IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN + IF( MYROW.EQ.IVXROW ) THEN +- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) ++ CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) + ELSE +- CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, ++ CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, + $ IVXROW, MYCOL ) + END IF + END IF +@@ -281,13 +284,13 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + * + 70 CONTINUE + CALL SCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 ) +- ESTOLD = EST +- CALL PSASUM( N, EST, V, IV, JV, DESCV, 1 ) ++ ESTOLD = ESTWORK( 1 ) ++ CALL PSASUM( N, ESTWORK( 1 ), V, IV, JV, DESCV, 1 ) + IF( DESCV( M_ ).EQ.1 .AND. N.EQ.1 ) THEN + IF( MYROW.EQ.IVXROW ) THEN +- CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1 ) ++ CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1 ) + ELSE +- CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, EST, 1, ++ CALL SGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, ESTWORK, 1, + $ IVXROW, MYCOL ) + END IF + END IF +@@ -305,7 +308,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. + * ALONG WITH IT, TEST FOR CYCLING. + * +- IF( IFLAG.EQ.0 .OR. EST.LE.ESTOLD ) ++ IF( IFLAG.EQ.0 .OR. ESTWORK( 1 ).LE.ESTOLD ) + $ GO TO 120 + * + DO 100 I = IOFFVX, IOFFVX+NP-1 +@@ -361,7 +364,7 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + * X HAS BEEN OVERWRITTEN BY A*X + * + 140 CONTINUE +- CALL PSASUM( N, TEMP, X, IX, JX, DESCX, 1 ) ++ CALL PSASUM( N, TEMP( 1 ), X, IX, JX, DESCX, 1 ) + IF( DESCX( M_ ).EQ.1 .AND. N.EQ.1 ) THEN + IF( MYROW.EQ.IVXROW ) THEN + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, TEMP, 1 ) +@@ -370,15 +373,16 @@ SUBROUTINE PSLACON( N, V, IV, JV, DESCV, X, IX, JX, DESCX, ISGN, + $ IVXROW, MYCOL ) + END IF + END IF +- TEMP = TWO*( TEMP / REAL( 3*N ) ) +- IF( TEMP.GT.EST ) THEN ++ TEMP( 1 ) = TWO*( TEMP( 1 ) / REAL( 3*N ) ) ++ IF( TEMP( 1 ).GT.ESTWORK( 1 ) ) THEN + CALL SCOPY( NP, X( IOFFVX ), 1, V( IOFFVX ), 1 ) +- EST = TEMP ++ ESTWORK( 1 ) = TEMP( 1 ) + END IF + * + 150 CONTINUE + KASE = 0 + * ++ EST = ESTWORK( 1 ) + RETURN + * + * End of PSLACON +diff --git a/SRC/pslarf.f b/SRC/pslarf.f +index c1d3a15..39de0ed 100644 +--- a/SRC/pslarf.f ++++ b/SRC/pslarf.f +@@ -241,7 +241,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, + $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, + $ NQ, RDEST +- REAL TAULOC ++ REAL TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBSTRNV, +@@ -335,7 +335,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -344,7 +344,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -362,8 +362,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -378,9 +378,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYCOL.EQ.ICCOL ) THEN + * +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -397,8 +397,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL SGER( MP, NQ, -TAULOC, V( IOFFV ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ CALL SGER( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -420,9 +420,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = MP+1 + CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -440,7 +440,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL SGER( MP, NQ, -TAULOC, WORK, 1, ++ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * +@@ -470,7 +470,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -479,7 +479,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -499,8 +499,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - v * w' + * + IF( IOFFC.GT.0 ) +- $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -515,18 +515,18 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( JJV ) + CALL SGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * + IPW = MP+1 + CALL SGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -546,8 +546,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - v * w' + * + IF( IOFFC.GT.0 ) +- $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -576,9 +576,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYROW.EQ.ICROW ) THEN + * +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -596,7 +596,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - w * v' + * + IF( IOFFV.GT.0 .AND. IOFFC.GT.0 ) +- $ CALL SGER( MP, NQ, -TAULOC, WORK, 1, ++ $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC ), LDC ) + END IF + * +@@ -619,9 +619,9 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = NQ+1 + CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -639,7 +639,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, ++ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, + $ WORK, 1, C( IOFFC ), LDC ) + END IF + * +@@ -665,7 +665,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -674,7 +674,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -692,8 +692,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1 ++ $ , WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -718,18 +718,18 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( IIV ) + CALL SGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * + IPW = NQ+1 + CALL SGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -748,8 +748,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - w * v' + * + IF( IOFFC.GT.0 ) +- $ CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ $ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -768,7 +768,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -777,7 +777,7 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -795,8 +795,8 @@ SUBROUTINE PSLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL SGER( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, +- $ C( IOFFC ), LDC ) ++ CALL SGER( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, WORK, ++ $ 1, C( IOFFC ), LDC ) + END IF + * + END IF +diff --git a/SRC/pslarz.f b/SRC/pslarz.f +index aa70db7..8901530 100644 +--- a/SRC/pslarz.f ++++ b/SRC/pslarz.f +@@ -250,7 +250,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, + $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, + $ NQC2, NQV, RDEST +- REAL TAULOC ++ REAL TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBSTRNV, +@@ -369,7 +369,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -378,7 +378,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -401,9 +401,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -419,9 +419,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYCOL.EQ.ICCOL2 ) THEN + * +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -444,11 +444,11 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL SAXPY( NQC2, -TAULOC, WORK, ++ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK, + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL SGER( MPV, NQC2, -TAULOC, V( IOFFV ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL SGER( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -470,9 +470,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = MPV+1 + CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -495,10 +495,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -529,7 +529,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL SGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -538,7 +538,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -561,10 +561,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -579,18 +579,18 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( JJV ) + CALL SGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * + IPW = MPV+1 + CALL SGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -613,10 +613,10 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL SAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL SAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL SGER( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL SGER( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -645,9 +645,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYROW.EQ.ICROW2 ) THEN + * +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -668,13 +668,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ ICCOL2 ) + * + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL SAXPY( MPC2, -TAULOC, WORK, 1, ++ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK, 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * + IF( MPC2.GT.0 .AND. NQV.GT.0 ) +- $ CALL SGER( MPC2, NQV, -TAULOC, WORK, 1, ++ $ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC2 ), + $ LDC ) + END IF +@@ -698,9 +698,9 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = NQV+1 + CALL SGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -719,13 +719,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), + $ RDEST, ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1, +- $ C( IOFFC1 ), 1 ) ++ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -750,7 +750,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -759,7 +759,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -778,12 +778,12 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, ++ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, + $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -808,18 +808,18 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( IIV ) + CALL SGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * + IPW = NQV+1 + CALL SGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -839,13 +839,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -864,7 +864,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL SGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -873,7 +873,7 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -892,13 +892,13 @@ SUBROUTINE PSLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL SAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL SAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL SGER( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL SGER( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +diff --git a/SRC/pslawil.f b/SRC/pslawil.f +index e04c16b..671e08e 100644 +--- a/SRC/pslawil.f ++++ b/SRC/pslawil.f +@@ -120,10 +120,14 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + INTEGER CONTXT, DOWN, HBL, ICOL, IROW, JSRC, LDA, LEFT, + $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT, + $ RSRC, UP +- REAL H11, H12, H21, H22, H33S, H44S, S, V1, V2, V3 ++ REAL H22, H33S, H44S, S, V1, V2 + * .. + * .. Local Arrays .. + REAL BUF( 4 ) ++ REAL H11( 1 ) ++ REAL H12( 1 ) ++ REAL H21( 1 ) ++ REAL V3( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, SGERV2D, SGESD2D, INFOG2L +@@ -170,18 +174,18 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( NPCOL.GT.1 ) THEN + CALL SGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT ) + ELSE +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + IF( NUM.GT.1 ) THEN + CALL SGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT ) +- H11 = BUF( 1 ) +- H21 = BUF( 2 ) +- H12 = BUF( 3 ) ++ H11( 1 ) = BUF( 1 ) ++ H21( 1 ) = BUF( 2 ) ++ H12( 1 ) = BUF( 3 ) + H22 = BUF( 4 ) + ELSE +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) + END IF + END IF +@@ -214,20 +218,20 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( NUM.GT.1 ) THEN + CALL SGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT ) + ELSE +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) + END IF + IF( NPROW.GT.1 ) THEN + CALL SGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL ) + ELSE +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + END IF + IF( NPCOL.GT.1 ) THEN + CALL SGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT ) + ELSE +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) + END IF + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + END IF + IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) +@@ -236,24 +240,24 @@ SUBROUTINE PSLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( MODKM1.GT.1 ) THEN + CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, + $ IROW, ICOL, RSRC, JSRC ) +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + * +- H44S = H44 - H11 +- H33S = H33 - H11 +- V1 = ( H33S*H44S-H43H34 ) / H21 + H12 +- V2 = H22 - H11 - H33S - H44S +- S = ABS( V1 ) + ABS( V2 ) + ABS( V3 ) ++ H44S = H44 - H11( 1 ) ++ H33S = H33 - H11( 1 ) ++ V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 ) ++ V2 = H22 - H11( 1 ) - H33S - H44S ++ S = ABS( V1 ) + ABS( V2 ) + ABS( V3( 1 ) ) + V1 = V1 / S + V2 = V2 / S +- V3 = V3 / S ++ V3( 1 ) = V3( 1 ) / S + V( 1 ) = V1 + V( 2 ) = V2 +- V( 3 ) = V3 ++ V( 3 ) = V3( 1 ) + * + RETURN + * +diff --git a/SRC/psstebz.f b/SRC/psstebz.f +index a8a2496..7e588a9 100644 +--- a/SRC/psstebz.f ++++ b/SRC/psstebz.f +@@ -244,14 +244,14 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, + $ ITMP2, J, JB, K, LAST, LEXTRA, LREQ, MYCOL, + $ MYROW, NALPHA, NBETA, NCMP, NEIGINT, NEXT, NGL, + $ NGLOB, NGU, NINT, NPCOL, NPROW, OFFSET, +- $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF, +- $ TORECV ++ $ ONEDCONTEXT, P, PREV, REXTRA, RREQ, SELF + REAL ALPHA, ATOLI, BETA, BNORM, DRECV, DSEND, GL, + $ GU, INITVL, INITVU, LSAVE, MID, PIVMIN, RELTOL, + $ SAFEMN, TMP1, TMP2, TNORM, ULP + * .. + * .. Local Arrays .. + INTEGER IDUM( 5, 2 ) ++ INTEGER TORECV( 1, 1 ) + * .. + * .. Executable Statements .. + * This is just to keep ftnchek happy +@@ -774,14 +774,14 @@ SUBROUTINE PSSTEBZ( ICTXT, RANGE, ORDER, N, VL, VU, IL, IU, + ELSE + CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', 1, 1, TORECV, 1, 0, + $ I-1 ) +- IF( TORECV.NE.0 ) THEN +- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, IWORK, +- $ TORECV, 0, I-1 ) +- CALL SGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, WORK, +- $ TORECV, 0, I-1 ) +- CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV, 1, +- $ IWORK( N+1 ), TORECV, 0, I-1 ) +- DO 120 J = 1, TORECV ++ IF( TORECV( 1, 1 ).NE.0 ) THEN ++ CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, ++ $ IWORK, TORECV( 1, 1 ), 0, I-1 ) ++ CALL SGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, ++ $ WORK, TORECV( 1, 1 ), 0, I-1 ) ++ CALL IGEBR2D( ONEDCONTEXT, 'ALL', ' ', TORECV( 1, 1 ), 1, ++ $ IWORK( N+1 ), TORECV( 1, 1 ), 0, I-1 ) ++ DO 120 J = 1, TORECV( 1, 1 ) + W( IWORK( J ) ) = WORK( J ) + IBLOCK( IWORK( J ) ) = IWORK( N+J ) + 120 CONTINUE +diff --git a/SRC/pstrord.f b/SRC/pstrord.f +index 3562242..5cdb549 100644 +--- a/SRC/pstrord.f ++++ b/SRC/pstrord.f +@@ -328,12 +328,13 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + $ EAST, WEST, ILOC4, SOUTH, NORTH, INDXS, + $ ITT, JTT, ILEN, DLEN, INDXE, TRSRC1, TCSRC1, + $ TRSRC2, TCSRC2, ILOS, DIR, TLIHI, TLILO, TLSEL, +- $ ROUND, LAST, WIN0S, WIN0E, WINE, MMAX, MMIN ++ $ ROUND, LAST, WIN0S, WIN0E, WINE + REAL ELEM, ELEM1, ELEM2, ELEM3, ELEM4, SN, CS, TMP, + $ ELEM5 + * .. + * .. Local Arrays .. +- INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ) ++ INTEGER IBUFF( 8 ), IDUM1( 1 ), IDUM2( 1 ), MMAX( 1 ), ++ $ MMIN( 1 ), INFODUM( 1 ) + * .. + * .. External Functions .. + LOGICAL LSAME +@@ -483,16 +484,16 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + END IF + IF( SELECT(K).NE.0 ) M = M + 1 + 10 CONTINUE +- MMAX = M +- MMIN = M ++ MMAX( 1 ) = M ++ MMIN( 1 ) = M + IF( NPROCS.GT.1 ) + $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1, + $ -1, -1, -1, -1 ) + IF( NPROCS.GT.1 ) + $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1, + $ -1, -1, -1, -1 ) +- IF( MMAX.GT.MMIN ) THEN +- M = MMAX ++ IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN ++ M = MMAX( 1 ) + IF( NPROCS.GT.1 ) + $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, SELECT, N, + $ -1, -1, -1, -1, -1 ) +@@ -520,9 +521,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * + * Global maximum on info. + * +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1, +- $ -1, -1 ) ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, ++ $ -1, -1, -1 ) ++ INFO = INFODUM( 1 ) ++ END IF + * + * Return if some argument is incorrect. + * +@@ -1576,9 +1579,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * experienced a failure in the reordering. + * + MYIERR = IERR +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, + $ -1, -1, -1, -1 ) ++ IERR = INFODUM( 1 ) ++ END IF + * + IF( IERR.NE.0 ) THEN + * +@@ -1586,9 +1591,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * to swap. + * + IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1) +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, + $ -1, -1, -1, -1 ) ++ INFO = INFODUM( 1 ) ++ END IF + GO TO 300 + END IF + * +@@ -3245,9 +3252,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * experienced a failure in the reordering. + * + MYIERR = IERR +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, IERR, 1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, + $ -1, -1, -1, -1 ) ++ IERR = INFODUM( 1 ) ++ END IF + * + IF( IERR.NE.0 ) THEN + * +@@ -3255,9 +3264,11 @@ SUBROUTINE PSTRORD( COMPQ, SELECT, PARA, N, T, IT, JT, + * to swap. + * + IF( MYIERR.NE.0 ) INFO = MAX(1,I+KKS-1) +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, + $ -1, -1, -1, -1 ) ++ INFO = INFODUM( 1 ) ++ END IF + GO TO 300 + END IF + * +diff --git a/SRC/pstrsen.f b/SRC/pstrsen.f +index 6219bdb..1922e8f 100644 +--- a/SRC/pstrsen.f ++++ b/SRC/pstrsen.f +@@ -354,13 +354,15 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, + LOGICAL LQUERY, WANTBH, WANTQ, WANTS, WANTSP + INTEGER ICOFFT12, ICTXT, IDUM1, IDUM2, IERR, ILOC1, + $ IPW1, ITER, ITT, JLOC1, JTT, K, LIWMIN, LLDT, +- $ LLDQ, LWMIN, MMAX, MMIN, MYROW, MYCOL, N1, N2, ++ $ LLDQ, LWMIN, MYROW, MYCOL, N1, N2, + $ NB, NOEXSY, NPCOL, NPROCS, NPROW, SPACE, + $ T12ROWS, T12COLS, TCOLS, TCSRC, TROWS, TRSRC, + $ WRK1, IWRK1, WRK2, IWRK2, WRK3, IWRK3 +- REAL DPDUM1, ELEM, EST, SCALE, RNORM ++ REAL ELEM, EST, SCALE, RNORM + * .. Local Arrays .. +- INTEGER DESCT12( DLEN_ ), MBNB2( 2 ) ++ INTEGER DESCT12( DLEN_ ), MBNB2( 2 ), MMAX( 1 ), ++ $ MMIN( 1 ), INFODUM( 1 ) ++ REAL DPDUM1( 1 ) + * .. + * .. External Functions .. + LOGICAL LSAME +@@ -521,16 +523,16 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, + END IF + IF( SELECT(K) ) M = M + 1 + 10 CONTINUE +- MMAX = M +- MMIN = M ++ MMAX( 1 ) = M ++ MMIN( 1 ) = M + IF( NPROCS.GT.1 ) + $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, MMAX, 1, -1, + $ -1, -1, -1, -1 ) + IF( NPROCS.GT.1 ) + $ CALL IGAMN2D( ICTXT, 'All', TOP, 1, 1, MMIN, 1, -1, + $ -1, -1, -1, -1 ) +- IF( MMAX.GT.MMIN ) THEN +- M = MMAX ++ IF( MMAX( 1 ).GT.MMIN( 1 ) ) THEN ++ M = MMAX( 1 ) + IF( NPROCS.GT.1 ) + $ CALL IGAMX2D( ICTXT, 'All', TOP, N, 1, IWORK, N, + $ -1, -1, -1, -1, -1 ) +@@ -602,9 +604,11 @@ SUBROUTINE PSTRSEN( JOB, COMPQ, SELECT, PARA, N, T, IT, JT, + * + * Global maximum on info + * +- IF( NPROCS.GT.1 ) +- $ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFO, 1, -1, -1, -1, ++ IF( NPROCS.GT.1 ) THEN ++ CALL IGAMX2D( ICTXT, 'All', TOP, 1, 1, INFODUM, 1, -1, -1, -1, + $ -1, -1 ) ++ INFO = INFODUM( 1 ) ++ END IF + * + * Return if some argument is incorrect + * +diff --git a/SRC/pzlarf.f b/SRC/pzlarf.f +index df65912..7bff287 100644 +--- a/SRC/pzlarf.f ++++ b/SRC/pzlarf.f +@@ -242,7 +242,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, + $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, + $ NQ, RDEST +- COMPLEX*16 TAULOC ++ COMPLEX*16 TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV, +@@ -336,7 +336,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -345,7 +345,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -363,8 +363,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -379,9 +379,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYCOL.EQ.ICCOL ) THEN + * +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -398,7 +398,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL ZGERC( MP, NQ, -TAULOC, V( IOFFV ), 1, ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, + $ WORK, 1, C( IOFFC ), LDC ) + END IF + * +@@ -421,9 +421,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = MP+1 + CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -441,7 +441,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * +@@ -471,7 +471,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -480,7 +480,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -500,8 +500,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - v * w' + * + IF( IOFFC.GT.0 ) +- $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -516,18 +516,18 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( JJV ) + CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * + IPW = MP+1 + CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -547,8 +547,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - v * w' + * + IF( IOFFC.GT.0 ) +- $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -577,9 +577,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYROW.EQ.ICROW ) THEN + * +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -597,7 +597,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - w * v' + * + IF( IOFFV.GT.0 .AND. IOFFC.GT.0 ) +- $ CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, ++ $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC ), + $ LDC ) + END IF +@@ -621,9 +621,9 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = NQ+1 + CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -641,8 +641,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -667,7 +667,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -676,7 +676,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -694,8 +694,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -720,18 +720,18 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( IIV ) + CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * + IPW = NQ+1 + CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -750,8 +750,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * sub( C ) := sub( C ) - w * v' + * + IF( IOFFC.GT.0 ) +- $ CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ $ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -770,7 +770,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -779,7 +779,7 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -797,8 +797,8 @@ SUBROUTINE PZLARF( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, +- $ C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +diff --git a/SRC/pzlarfc.f b/SRC/pzlarfc.f +index eb469fc..ddd7ec6 100644 +--- a/SRC/pzlarfc.f ++++ b/SRC/pzlarfc.f +@@ -242,7 +242,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + $ IOFFV, IPW, IROFF, IVCOL, IVROW, JJC, JJV, LDC, + $ LDV, MYCOL, MYROW, MP, NCC, NCV, NPCOL, NPROW, + $ NQ, RDEST +- COMPLEX*16 TAULOC ++ COMPLEX*16 TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV, +@@ -336,17 +336,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = DCONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) + * + ELSE + * + CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAULOC, 1, IVROW, MYCOL ) +- TAULOC = DCONJG( TAULOC ) ++ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -364,8 +364,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -380,9 +380,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYCOL.EQ.ICCOL ) THEN + * +- TAULOC = DCONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -399,7 +399,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL ZGERC( MP, NQ, -TAULOC, V( IOFFV ), 1, ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), V( IOFFV ), 1, + $ WORK, 1, C( IOFFC ), LDC ) + END IF + * +@@ -422,9 +422,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = MP+1 + CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = DCONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -442,7 +442,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * +@@ -472,17 +472,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = DCONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) + * + ELSE + * + CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, + $ 1, IVROW, MYCOL ) +- TAULOC = DCONJG( TAULOC ) ++ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -500,8 +500,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1, +- $ C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -516,18 +516,18 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( JJV ) + CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = DCONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) + * + ELSE + * + IPW = MP+1 + CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = DCONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -545,8 +545,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - v * w' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, WORK( IPW ), 1, +- $ C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -575,9 +575,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + IF( MYROW.EQ.ICROW ) THEN + * +- TAULOC = DCONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -594,7 +594,7 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK, 1, ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC ), LDC ) + END IF + * +@@ -617,9 +617,9 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + IPW = NQ+1 + CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = DCONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -637,8 +637,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -663,17 +663,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = DCONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) + * + ELSE + * + CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, + $ 1, MYROW, IVCOL ) +- TAULOC = DCONJG( TAULOC ) ++ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -691,8 +691,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +@@ -716,18 +716,18 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + WORK(IPW) = TAU( IIV ) + CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = DCONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) + * + ELSE + * + IPW = NQ+1 + CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = DCONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -745,8 +745,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, +- $ C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + ELSE +@@ -765,17 +765,17 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = DCONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) + * + ELSE + * + CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1, + $ MYROW, IVCOL ) +- TAULOC = DCONJG( TAULOC ) ++ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -793,8 +793,8 @@ SUBROUTINE PZLARFC( SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MP, NQ, -TAULOC, WORK( IPW ), 1, WORK, 1, +- $ C( IOFFC ), LDC ) ++ CALL ZGERC( MP, NQ, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC ), LDC ) + END IF + * + END IF +diff --git a/SRC/pzlarz.f b/SRC/pzlarz.f +index fefc133..abf6288 100644 +--- a/SRC/pzlarz.f ++++ b/SRC/pzlarz.f +@@ -251,7 +251,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, + $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, + $ NQC2, NQV, RDEST +- COMPLEX*16 TAULOC ++ COMPLEX*16 TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV, +@@ -370,7 +370,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -379,7 +379,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -402,9 +402,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -420,9 +420,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYCOL.EQ.ICCOL2 ) THEN + * +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -445,11 +445,11 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK, ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK, + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -471,9 +471,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = MPV+1 + CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -496,10 +496,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -530,7 +530,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * +@@ -539,7 +539,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -562,10 +562,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -580,18 +580,18 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( JJV ) + CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * + IPW = MPV+1 + CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -614,10 +614,10 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -646,9 +646,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYROW.EQ.ICROW2 ) THEN + * +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -669,13 +669,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ ICCOL2 ) + * + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK, 1, ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK, 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * + IF( MPC2.GT.0 .AND. NQV.GT.0 ) +- $ CALL ZGERC( MPC2, NQV, -TAULOC, WORK, 1, ++ $ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC2 ), + $ LDC ) + END IF +@@ -699,9 +699,9 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = NQV+1 + CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -720,13 +720,14 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), + $ RDEST, ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, +- $ C( IOFFC1 ), 1 ) ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), ++ $ WORK( IPW ), 1, WORK, 1, ++ $ C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -751,7 +752,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -760,7 +761,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -779,13 +780,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -809,18 +810,18 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( IIV ) + CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = TAU( IIV ) ++ TAULOC( 1 ) = TAU( IIV ) + * + ELSE + * + IPW = NQV+1 + CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = WORK( IPW ) ++ TAULOC( 1 ) = WORK( IPW ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -840,13 +841,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -865,7 +866,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = TAU( JJV ) ++ TAULOC( 1 ) = TAU( JJV ) + * + ELSE + * +@@ -874,7 +875,7 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -893,13 +894,13 @@ SUBROUTINE PZLARZ( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +diff --git a/SRC/pzlarzc.f b/SRC/pzlarzc.f +index 936caec..2c574ff 100644 +--- a/SRC/pzlarzc.f ++++ b/SRC/pzlarzc.f +@@ -251,7 +251,7 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ IVCOL, IVROW, JJC1, JJC2, JJV, LDC, LDV, MPC2, + $ MPV, MYCOL, MYROW, NCC, NCV, NPCOL, NPROW, + $ NQC2, NQV, RDEST +- COMPLEX*16 TAULOC ++ COMPLEX*16 TAULOC( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, INFOG2L, PB_TOPGET, PBZTRNV, +@@ -370,17 +370,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = DCONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) + * + ELSE + * + CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAULOC, 1, IVROW, MYCOL ) +- TAULOC = DCONJG( TAULOC ) ++ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -403,9 +403,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -421,9 +421,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYCOL.EQ.ICCOL2 ) THEN + * +- TAULOC = DCONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -446,11 +446,11 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK, ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK, + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, V( IOFFV ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), V( IOFFV ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -472,9 +472,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = MPV+1 + CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, MYROW, + $ IVCOL ) +- TAULOC = DCONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -497,10 +497,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), + $ LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, + $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * +@@ -531,17 +531,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL ZGEBS2D( ICTXT, 'Columnwise', ' ', 1, 1, + $ TAU( IIV ), 1 ) +- TAULOC = DCONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) + * + ELSE + * + CALL ZGEBR2D( ICTXT, 'Columnwise', ' ', 1, 1, TAULOC, + $ 1, IVROW, MYCOL ) +- TAULOC = DCONJG( TAULOC ) ++ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -564,10 +564,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -582,18 +582,18 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( JJV ) + CALL ZGEBS2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = DCONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) + * + ELSE + * + IPW = MPV+1 + CALL ZGEBR2D( ICTXT, 'Rowwise', ROWBTOP, IPW, 1, WORK, + $ IPW, MYROW, IVCOL ) +- TAULOC = DCONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C )' * v + * +@@ -616,10 +616,10 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * sub( C ) := sub( C ) - v * w' + * + IF( MYROW.EQ.ICROW1 ) +- $ CALL ZAXPY( NQC2, -TAULOC, WORK( IPW ), ++ $ CALL ZAXPY( NQC2, -TAULOC( 1 ), WORK( IPW ), + $ MAX( 1, NQC2 ), C( IOFFC1 ), LDC ) +- CALL ZGERC( MPV, NQC2, -TAULOC, WORK, 1, WORK( IPW ), +- $ 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPV, NQC2, -TAULOC( 1 ), WORK, 1, ++ $ WORK( IPW ), 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -648,9 +648,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + IF( MYROW.EQ.ICROW2 ) THEN + * +- TAULOC = DCONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -671,12 +671,12 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ ICCOL2 ) + * + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK, 1, ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK, 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MPC2, NQV, -TAULOC, WORK, 1, ++ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK, 1, + $ V( IOFFV ), LDV, C( IOFFC2 ), LDC ) + END IF + * +@@ -699,9 +699,9 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + IPW = NQV+1 + CALL ZGERV2D( ICTXT, IPW, 1, WORK, IPW, IVROW, + $ MYCOL ) +- TAULOC = DCONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -720,13 +720,14 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), + $ RDEST, ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, +- $ C( IOFFC1 ), 1 ) ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), ++ $ WORK( IPW ), 1, WORK, 1, ++ $ C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -751,17 +752,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, + $ TAU( JJV ), 1 ) +- TAULOC = DCONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) + * + ELSE + * + CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, + $ 1, MYROW, IVCOL ) +- TAULOC = DCONJG( TAULOC ) ++ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -780,13 +781,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, +- $ WORK, 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), ++ $ 1, WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +@@ -810,18 +811,18 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + WORK( IPW ) = TAU( IIV ) + CALL ZGEBS2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW ) +- TAULOC = DCONJG( TAU( IIV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( IIV ) ) + * + ELSE + * + IPW = NQV+1 + CALL ZGEBR2D( ICTXT, 'Columnwise', COLBTOP, IPW, 1, + $ WORK, IPW, IVROW, MYCOL ) +- TAULOC = DCONJG( WORK( IPW ) ) ++ TAULOC( 1 ) = DCONJG( WORK( IPW ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -841,13 +842,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + ELSE +@@ -866,17 +867,17 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + * + CALL ZGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, TAU( JJV ), + $ 1 ) +- TAULOC = DCONJG( TAU( JJV ) ) ++ TAULOC( 1 ) = DCONJG( TAU( JJV ) ) + * + ELSE + * + CALL ZGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, TAULOC, 1, + $ MYROW, IVCOL ) +- TAULOC = DCONJG( TAULOC ) ++ TAULOC( 1 ) = DCONJG( TAULOC( 1 ) ) + * + END IF + * +- IF( TAULOC.NE.ZERO ) THEN ++ IF( TAULOC( 1 ).NE.ZERO ) THEN + * + * w := sub( C ) * v + * +@@ -895,13 +896,13 @@ SUBROUTINE PZLARZC( SIDE, M, N, L, V, IV, JV, DESCV, INCV, TAU, C, + $ WORK( IPW ), MAX( 1, MPC2 ), RDEST, + $ ICCOL2 ) + IF( MYCOL.EQ.ICCOL1 ) +- $ CALL ZAXPY( MPC2, -TAULOC, WORK( IPW ), 1, ++ $ CALL ZAXPY( MPC2, -TAULOC( 1 ), WORK( IPW ), 1, + $ C( IOFFC1 ), 1 ) + * + * sub( C ) := sub( C ) - w * v' + * +- CALL ZGERC( MPC2, NQV, -TAULOC, WORK( IPW ), 1, WORK, +- $ 1, C( IOFFC2 ), LDC ) ++ CALL ZGERC( MPC2, NQV, -TAULOC( 1 ), WORK( IPW ), 1, ++ $ WORK, 1, C( IOFFC2 ), LDC ) + END IF + * + END IF +diff --git a/SRC/pzlattrs.f b/SRC/pzlattrs.f +index 819e476..5a54209 100644 +--- a/SRC/pzlattrs.f ++++ b/SRC/pzlattrs.f +@@ -271,8 +271,9 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + $ JINC, JLAST, LDA, LDX, MB, MYCOL, MYROW, NB, + $ NPCOL, NPROW, RSRC + DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL, +- $ XBND, XJ, XMAX ++ $ XBND, XJ + COMPLEX*16 CSUMJ, TJJS, USCAL, XJTMP, ZDUM ++ DOUBLE PRECISION XMAX( 1 ) + * .. + * .. External Functions .. + LOGICAL LSAME +@@ -391,11 +392,11 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + * Compute a bound on the computed solution vector to see if the + * Level 2 PBLAS routine PZTRSV can be used. + * +- XMAX = ZERO ++ XMAX( 1 ) = ZERO + CALL PZAMAX( N, ZDUM, IMAX, X, IX, JX, DESCX, 1 ) +- XMAX = CABS2( ZDUM ) ++ XMAX( 1 ) = CABS2( ZDUM ) + CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, -1, -1 ) +- XBND = XMAX ++ XBND = XMAX( 1 ) + * + IF( NOTRAN ) THEN + * +@@ -590,16 +591,16 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + * + * Use a Level 1 PBLAS solve, scaling intermediate results. + * +- IF( XMAX.GT.BIGNUM*HALF ) THEN ++ IF( XMAX( 1 ).GT.BIGNUM*HALF ) THEN + * + * Scale X so that its components are less than or equal to + * BIGNUM in absolute value. + * +- SCALE = ( BIGNUM*HALF ) / XMAX ++ SCALE = ( BIGNUM*HALF ) / XMAX( 1 ) + CALL PZDSCAL( N, SCALE, X, IX, JX, DESCX, 1 ) +- XMAX = BIGNUM ++ XMAX( 1 ) = BIGNUM + ELSE +- XMAX = XMAX*TWO ++ XMAX( 1 ) = XMAX( 1 )*TWO + END IF + * + IF( NOTRAN ) THEN +@@ -651,7 +652,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * X( J ) = ZLADIV( X( J ), TJJS ) +@@ -682,7 +683,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + * X( J ) = ZLADIV( X( J ), TJJS ) + * XJ = CABS1( X( J ) ) +@@ -706,7 +707,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + XJTMP = CONE + XJ = ONE + SCALE = ZERO +- XMAX = ZERO ++ XMAX( 1 ) = ZERO + END IF + 90 CONTINUE + * +@@ -715,7 +716,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + * + IF( XJ.GT.ONE ) THEN + REC = ONE / XJ +- IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN ++ IF( CNORM( J ).GT.( BIGNUM-XMAX( 1 ) )*REC ) THEN + * + * Scale x by 1/(2*abs(x(j))). + * +@@ -724,7 +725,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + XJTMP = XJTMP*REC + SCALE = SCALE*REC + END IF +- ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN ++ ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX( 1 ) ) ) THEN + * + * Scale x by 1/2. + * +@@ -743,7 +744,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZAXPY( J-1, ZDUM, A, IA, JA+J-1, DESCA, 1, X, + $ IX, JX, DESCX, 1 ) + CALL PZAMAX( J-1, ZDUM, IMAX, X, IX, JX, DESCX, 1 ) +- XMAX = CABS1( ZDUM ) ++ XMAX( 1 ) = CABS1( ZDUM ) + CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, + $ -1, -1 ) + END IF +@@ -757,7 +758,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZAXPY( N-J, ZDUM, A, IA+J, JA+J-1, DESCA, 1, + $ X, IX+J, JX, DESCX, 1 ) + CALL PZAMAX( N-J, ZDUM, I, X, IX+J, JX, DESCX, 1 ) +- XMAX = CABS1( ZDUM ) ++ XMAX( 1 ) = CABS1( ZDUM ) + CALL DGSUM2D( CONTXT, 'Row', ' ', 1, 1, XMAX, 1, + $ -1, -1 ) + END IF +@@ -785,7 +786,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + END IF + XJ = CABS1( XJTMP ) + USCAL = DCMPLX( TSCAL ) +- REC = ONE / MAX( XMAX, ONE ) ++ REC = ONE / MAX( XMAX( 1 ), ONE ) + IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN + * + * If x(j) could overflow, scale x by 1/(2*XMAX). +@@ -820,7 +821,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * +@@ -924,7 +925,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * X( J ) = ZLADIV( X( J ), TJJS ) +@@ -945,7 +946,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + * X( J ) = ZLADIV( X( J ), TJJS ) + XJTMP = ZLADIV( XJTMP, TJJS ) +@@ -966,7 +967,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + END IF + XJTMP = CONE + SCALE = ZERO +- XMAX = ZERO ++ XMAX( 1 ) = ZERO + END IF + 110 CONTINUE + ELSE +@@ -981,7 +982,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + X( IROWX ) = XJTMP + END IF + END IF +- XMAX = MAX( XMAX, CABS1( XJTMP ) ) ++ XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) ) + 120 CONTINUE + * + ELSE +@@ -1004,7 +1005,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + END IF + XJ = CABS1( XJTMP ) + USCAL = TSCAL +- REC = ONE / MAX( XMAX, ONE ) ++ REC = ONE / MAX( XMAX( 1 ), ONE ) + IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN + * + * If x(j) could overflow, scale x by 1/(2*XMAX). +@@ -1039,7 +1040,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * +@@ -1145,7 +1146,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + END IF + * X( J ) = ZLADIV( X( J ), TJJS ) +@@ -1164,7 +1165,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + CALL PZDSCAL( N, REC, X, IX, JX, DESCX, 1 ) + XJTMP = XJTMP*REC + SCALE = SCALE*REC +- XMAX = XMAX*REC ++ XMAX( 1 ) = XMAX( 1 )*REC + END IF + * X( J ) = ZLADIV( X( J ), TJJS ) + XJTMP = ZLADIV( XJTMP, TJJS ) +@@ -1181,7 +1182,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + $ X( IROWX ) = CONE + XJTMP = CONE + SCALE = ZERO +- XMAX = ZERO ++ XMAX( 1 ) = ZERO + END IF + 130 CONTINUE + ELSE +@@ -1194,7 +1195,7 @@ SUBROUTINE PZLATTRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA, JA, + IF( ( MYROW.EQ.ITMP1X ) .AND. ( MYCOL.EQ.ITMP2X ) ) + $ X( IROWX ) = XJTMP + END IF +- XMAX = MAX( XMAX, CABS1( XJTMP ) ) ++ XMAX( 1 ) = MAX( XMAX( 1 ), CABS1( XJTMP ) ) + 140 CONTINUE + END IF + SCALE = SCALE / TSCAL +diff --git a/SRC/pzlawil.f b/SRC/pzlawil.f +index e89a9a3..7e502ef 100644 +--- a/SRC/pzlawil.f ++++ b/SRC/pzlawil.f +@@ -124,11 +124,10 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + $ MODKM1, MYCOL, MYROW, NPCOL, NPROW, NUM, RIGHT, + $ RSRC, UP + DOUBLE PRECISION S +- COMPLEX*16 CDUM, H11, H12, H21, H22, H33S, H44S, V1, V2, +- $ V3 ++ COMPLEX*16 CDUM, H22, H33S, H44S, V1, V2 + * .. + * .. Local Arrays .. +- COMPLEX*16 BUF( 4 ) ++ COMPLEX*16 BUF( 4 ), H11( 1 ), H12( 1 ), H21( 1 ), V3( 1 ) + * .. + * .. External Subroutines .. + EXTERNAL BLACS_GRIDINFO, INFOG2L, ZGERV2D, ZGESD2D +@@ -181,18 +180,18 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( NPCOL.GT.1 ) THEN + CALL ZGERV2D( CONTXT, 1, 1, V3, 1, MYROW, LEFT ) + ELSE +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + IF( NUM.GT.1 ) THEN + CALL ZGERV2D( CONTXT, 4, 1, BUF, 4, UP, LEFT ) +- H11 = BUF( 1 ) +- H21 = BUF( 2 ) +- H12 = BUF( 3 ) ++ H11( 1 ) = BUF( 1 ) ++ H21( 1 ) = BUF( 2 ) ++ H12( 1 ) = BUF( 3 ) + H22 = BUF( 4 ) + ELSE +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) + END IF + END IF +@@ -225,20 +224,20 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( NUM.GT.1 ) THEN + CALL ZGERV2D( CONTXT, 1, 1, H11, 1, UP, LEFT ) + ELSE +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) + END IF + IF( NPROW.GT.1 ) THEN + CALL ZGERV2D( CONTXT, 1, 1, H12, 1, UP, MYCOL ) + ELSE +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + END IF + IF( NPCOL.GT.1 ) THEN + CALL ZGERV2D( CONTXT, 1, 1, H21, 1, MYROW, LEFT ) + ELSE +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) + END IF + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + END IF + IF( ( MYROW.NE.II ) .OR. ( MYCOL.NE.JJ ) ) +@@ -247,24 +246,24 @@ SUBROUTINE PZLAWIL( II, JJ, M, A, DESCA, H44, H33, H43H34, V ) + IF( MODKM1.GT.1 ) THEN + CALL INFOG2L( M+2, M+2, DESCA, NPROW, NPCOL, MYROW, MYCOL, + $ IROW, ICOL, RSRC, JSRC ) +- H11 = A( ( ICOL-3 )*LDA+IROW-2 ) +- H21 = A( ( ICOL-3 )*LDA+IROW-1 ) +- H12 = A( ( ICOL-2 )*LDA+IROW-2 ) ++ H11( 1 ) = A( ( ICOL-3 )*LDA+IROW-2 ) ++ H21( 1 ) = A( ( ICOL-3 )*LDA+IROW-1 ) ++ H12( 1 ) = A( ( ICOL-2 )*LDA+IROW-2 ) + H22 = A( ( ICOL-2 )*LDA+IROW-1 ) +- V3 = A( ( ICOL-2 )*LDA+IROW ) ++ V3( 1 ) = A( ( ICOL-2 )*LDA+IROW ) + END IF + * +- H44S = H44 - H11 +- H33S = H33 - H11 +- V1 = ( H33S*H44S-H43H34 ) / H21 + H12 +- V2 = H22 - H11 - H33S - H44S +- S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3 ) ++ H44S = H44 - H11( 1 ) ++ H33S = H33 - H11( 1 ) ++ V1 = ( H33S*H44S-H43H34 ) / H21( 1 ) + H12( 1 ) ++ V2 = H22 - H11( 1 ) - H33S - H44S ++ S = CABS1( V1 ) + CABS1( V2 ) + CABS1( V3( 1 ) ) + V1 = V1 / S + V2 = V2 / S +- V3 = V3 / S ++ V3( 1 ) = V3( 1 ) / S + V( 1 ) = V1 + V( 2 ) = V2 +- V( 3 ) = V3 ++ V( 3 ) = V3( 1 ) + * + RETURN + * +diff --git a/SRC/pztrevc.f b/SRC/pztrevc.f +index 0536475..3b27286 100644 +--- a/SRC/pztrevc.f ++++ b/SRC/pztrevc.f +@@ -218,11 +218,12 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + $ ITMP2, J, K, KI, LDT, LDVL, LDVR, LDW, MB, + $ MYCOL, MYROW, NB, NPCOL, NPROW, RSRC + REAL SELF +- DOUBLE PRECISION OVFL, REMAXD, SCALE, SMIN, SMLNUM, ULP, UNFL ++ DOUBLE PRECISION OVFL, REMAXD, SCALE, SMLNUM, ULP, UNFL + COMPLEX*16 CDUM, REMAXC, SHIFT + * .. + * .. Local Arrays .. + INTEGER DESCW( DLEN_ ) ++ DOUBLE PRECISION SMIN( 1 ) + * .. + * .. External Functions .. + LOGICAL LSAME +@@ -355,13 +356,13 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + $ GO TO 70 + END IF + * +- SMIN = ZERO ++ SMIN( 1 ) = ZERO + SHIFT = CZERO + CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL, + $ IROW, ICOL, ITMP1, ITMP2 ) + IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN + SHIFT = T( ( ICOL-1 )*LDT+IROW ) +- SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) ++ SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) + END IF + CALL DGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 ) + CALL ZGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 ) +@@ -396,8 +397,9 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN + T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) - + $ SHIFT +- IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) THEN +- T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN ) ++ IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) ) ++ $ THEN ++ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN( 1 ) ) + END IF + END IF + 50 CONTINUE +@@ -467,13 +469,13 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + $ GO TO 110 + END IF + * +- SMIN = ZERO ++ SMIN( 1 ) = ZERO + SHIFT = CZERO + CALL INFOG2L( KI, KI, DESCT, NPROW, NPCOL, MYROW, MYCOL, + $ IROW, ICOL, ITMP1, ITMP2 ) + IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN + SHIFT = T( ( ICOL-1 )*LDT+IROW ) +- SMIN = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) ++ SMIN( 1 ) = MAX( ULP*( CABS1( SHIFT ) ), SMLNUM ) + END IF + CALL DGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SMIN, 1, -1, -1 ) + CALL ZGSUM2D( CONTXT, 'ALL', ' ', 1, 1, SHIFT, 1, -1, -1 ) +@@ -507,8 +509,8 @@ SUBROUTINE PZTREVC( SIDE, HOWMNY, SELECT, N, T, DESCT, VL, DESCVL, + IF( ( MYROW.EQ.ITMP1 ) .AND. ( MYCOL.EQ.ITMP2 ) ) THEN + T( ( ICOL-1 )*LDT+IROW ) = T( ( ICOL-1 )*LDT+IROW ) - + $ SHIFT +- IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN ) +- $ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN ) ++ IF( CABS1( T( ( ICOL-1 )*LDT+IROW ) ).LT.SMIN( 1 ) ) ++ $ T( ( ICOL-1 )*LDT+IROW ) = DCMPLX( SMIN( 1 ) ) + END IF + 90 CONTINUE + * + +From 189c84001bcd564296a475c5c757afc9f337e828 Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Tiziano=20M=C3=BCller?= <tiziano.mueller@chem.uzh.ch> +Date: Thu, 25 Jun 2020 18:37:34 +0200 +Subject: [PATCH] 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() |