5685 lines
226 KiB
Diff
5685 lines
226 KiB
Diff
|
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()
|